perm filename WEAVE.POS[WEB,ALS]1 blob
sn#628254 filedate 1981-12-09 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00012 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 {2}{4}{$C-,A+,D-}{[$C+,D+]}
C00007 00003 {21}{PROCEDURE DEBUGHELPFORWARD}
C00017 00004 {38}PROCEDURE Newmodxref(p:namepointer)
C00028 00005 {67}PROCEDURE Skiplimbo
C00039 00006 {86}PROCEDURE Pascalxref
C00052 00007 {116}{PROCEDURE PRINTCAT(C:EIGHTBITS)
C00057 00008 {153}{PROCEDURE PROD(N:EIGHTBITS)
C00085 00009 {158}{167}PROCEDURE Appcomment
C00114 00010 {169}PROCEDURE Outerparse
C00131 00011 {194}PROCEDURE Finishpascal
C00141 00012 {225}BEGIN
C00172 ENDMK
C⊗;
{2}{4}{$C-,A+,D-}{[$C+,D+]}
PROGRAM Weave(input,output,tty);
LABEL
9999;
CONST
{7}maxbytes=20000;
maxnames=2000;
hashsize=353;
bufsize=100;
longestname=300;
longbufsize=400;
linelength=80;
maxrefs=12000;
maxtoks=20000;
maxtexts=2000;
maxscraps=1000;
stacksize=200;
TYPE
{8}asciicode=0..127;
{27}eightbits=0..255;
sixteenbits=0..65535;
{29}namepointer=0..maxnames;
{39}textpointer=0..maxtexts;
{171}mode=(inner,outer);
outputstate=RECORD endfield:sixteenbits;
tokfield:sixteenbits;
modefield:mode;
END;
VAR
{10}xord:ARRAY[char]OF asciicode;
xchr:ARRAY[asciicode]OF char;
{18}buffer:ARRAY[0..longbufsize]OF asciicode;
{20}phaseone:boolean;
{28}bytemem:PACKED ARRAY[0..maxbytes]OF asciicode;
bytestart:ARRAY[0..maxnames]OF sixteenbits;
link:ARRAY[0..maxnames]OF sixteenbits;
ilk:ARRAY[0..maxnames]OF sixteenbits;
xref:ARRAY[0..maxnames]OF sixteenbits;
{30}nameptr:namepointer;
byteptr:0..maxbytes;
{35}xmem:ARRAY[0..maxrefs]OF PACKED RECORD numfield:sixteenbits;
xlinkfield:sixteenbits;
END;
xrefptr:0..maxrefs;
modulecount:0..10239;
xrefswitch,modxrefswitc:0..10240;
{40}tokmem:PACKED ARRAY[0..maxtoks]OF sixteenbits;
tokstart:ARRAY[textpointer]OF sixteenbits;
textptr:textpointer;
tokptr:0..maxtoks;
{MAXTOKPTR,MAXTXTPTR:0..MAXTOKS;
}{42}idfirst:0..longbufsize;
idloc:0..longbufsize;
hash:ARRAY[0..hashsize]OF sixteenbits;
{50}curname:namepointer;
{52}module:ARRAY[0..longestname]OF asciicode;
{58}page:sixteenbits;
line:sixteenbits;
limit:0..longbufsize;
loc:0..longbufsize;
inputhasende:boolean;
{61}{OMITPAGE:BOOLEAN;}{71}curmodule:namepointer;
{83}nextcontrol:eightbits;
{89}lhs,rhs:namepointer;
{93}curxref:0..maxrefs;
{96}outbuf:ARRAY[0..linelength]OF asciicode;
outptr:0..linelength;
outpage,outline:sixteenbits;
{105}dig:ARRAY[0..4]OF 0..9;
{120}cat:ARRAY[0..maxscraps]OF eightbits;
trans:ARRAY[0..maxscraps]OF textpointer;
pp:0..maxscraps;
scrapbase:0..maxscraps;
scrapptr:0..maxscraps;
loptr:0..maxscraps;
hiptr:0..maxscraps;
{MAXSCRPTR:0..MAXSCRAPS;}{152}{TRACING:BOOLEAN;}
{172}curstate:outputstate;
stack:ARRAY[1..stacksize]OF outputstate;
stackptr:0..stacksize;
{MAXSTACKPTR:0..STACKSIZE;
}{189}saveline,saveplace:sixteenbits;
{197}thismodule:namepointer;
{206}bucket:ARRAY[asciicode]OF namepointer;
nextname:namepointer;
c:asciicode;
h:0..hashsize;
blink:ARRAY[0..maxnames]OF sixteenbits;
{208}curdepth:eightbits;
curbyte:0..maxbytes;
curval:sixteenbits;
{MAXSORTPTR:0..MAXSCRAPS;}
{210}collate:ARRAY[0..100]OF asciicode;
{218}nextxref,thisxref:0..maxrefs;
{222}{TROUBLESHOOT:BOOLEAN;
DDT:SIXTEENBITS;
DD:SIXTEENBITS;
DEBUGCYCLE:INTEGER;
DEBUGSKIPPED:INTEGER;}
{21}{PROCEDURE DEBUGHELP;FORWARD;}
{22}PROCEDURE Error;
VAR k,l:0..longbufsize;
BEGIN{23}
BEGIN
Writeln(tty,'. (p.',page:0,',l.',line:0,')');
IF loc>=limit THEN
l:=limit
ELSE
l:=loc;
FOR k:=1 TO l DO
IF buffer[k-1]=9 THEN Write(tty,' ')
ELSE Write(tty,xchr[buffer[k-1]]);
Writeln(tty);
FOR k:=1 TO l DO Write(tty,' ');
FOR k:=l+1 TO limit DO Write(tty,xchr[buffer[k-1]]);
Write(tty,' ');
END;
{DEBUGSKIPPED:=DEBUGCYCLE;DEBUGHELP;}
END;
{24}
PROCEDURE Quit;
BEGIN
GOTO 9999;
END;
PROCEDURE Initialize;
VAR
{9}i:0..127;
{43}h:0..hashsize;
BEGIN{11}
xchr[32]:=' '; xchr[33]:='!'; xchr[34]:='"'; xchr[35]:='#';
xchr[36]:='$'; xchr[37]:='%'; xchr[38]:='&'; xchr[39]:='''';
xchr[40]:='('; xchr[41]:=')'; xchr[42]:='*'; xchr[43]:='+';
xchr[44]:=','; xchr[45]:='-'; xchr[46]:='.'; xchr[47]:='/';
xchr[48]:='0'; xchr[49]:='1'; xchr[50]:='2'; xchr[51]:='3';
xchr[52]:='4'; xchr[53]:='5'; xchr[54]:='6'; xchr[55]:='7';
xchr[56]:='8'; xchr[57]:='9'; xchr[58]:=':'; xchr[59]:=';';
xchr[60]:='<'; xchr[61]:='='; xchr[62]:='>'; xchr[63]:='?';
xchr[64]:='@'; xchr[65]:='A'; xchr[66]:='B'; xchr[67]:='C';
xchr[68]:='D'; xchr[69]:='E'; xchr[70]:='F'; xchr[71]:='G';
xchr[72]:='H'; xchr[73]:='I'; xchr[74]:='J'; xchr[75]:='K';
xchr[76]:='L'; xchr[77]:='M'; xchr[78]:='N'; xchr[79]:='O';
xchr[80]:='P'; xchr[81]:='Q'; xchr[82]:='R'; xchr[83]:='S';
xchr[84]:='T'; xchr[85]:='U'; xchr[86]:='V'; xchr[87]:='W';
xchr[88]:='X'; xchr[89]:='Y'; xchr[90]:='Z'; xchr[91]:='[';
xchr[92]:='\'; xchr[93]:=']'; xchr[94]:='↑'; xchr[95]:='←';
xchr[96]:='`'; xchr[97]:='a'; xchr[98]:='b'; xchr[99]:='c';
xchr[100]:='d'; xchr[101]:='e'; xchr[102]:='f'; xchr[103]:='g';
xchr[104]:='h'; xchr[105]:='i'; xchr[106]:='j'; xchr[107]:='k';
xchr[108]:='l'; xchr[109]:='m'; xchr[110]:='n'; xchr[111]:='o';
xchr[112]:='p'; xchr[113]:='q'; xchr[114]:='r'; xchr[115]:='s';
xchr[116]:='t'; xchr[117]:='u'; xchr[118]:='v'; xchr[119]:='w';
xchr[120]:='x'; xchr[121]:='y'; xchr[122]:='z'; xchr[123]:='{';
xchr[124]:='|'; xchr[125]:='}'; xchr[126]:='~'; xchr[0]:=' ';
xchr[127]:=' ';
{13}
FOR i:=1 TO 31 DO xchr[i]:=Chr(i);
xchr[24]:=Chr(95); xchr[26]:=Chr(27); xchr[27]:=Chr(126);
{14}
FOR i:=0 TO 127 DO xord[Chr(i)]:=32;
FOR i:=1 TO 126 DO xord[xchr[i]]:=i;
{31}nameptr:=1;
byteptr:=1;
bytestart[0]:=1;
bytestart[1]:=1;
{33}ilk[0]:=0;
{36}xrefptr:=0;
xrefswitch:=0;
modxrefswitc:=0;
xmem[0].numfield:=0;
{41}tokptr:=1;
textptr:=1;
tokstart[0]:=1;
tokstart[1]:=1;
{MAXTOKPTR:=1;MAXTXTPTR:=1;}
{44}FOR h:=0 TO hashsize-1 DO hash[h]:=0;
{62}{OMITPAGE:=FALSE;}
{78}module[0]:=32;
{99}outptr:=1;
outpage:=1;
outline:=1;
outbuf[1]:=114;
Write('\input webhd');
{102}outbuf[0]:=92;
{121}scrapbase:=1;
scrapptr:=0;
{MAXSCRPTR:=0;}
{173}{MAXSTACKPTR:=0;}
{209}{MAXSORTPTR:=0;}
{211}collate[0]:=0;
collate[1]:=32;
FOR c:=1 TO 31 DO collate[c+1]:=c;
FOR c:=33 TO 47 DO collate[c]:=c;
FOR c:=58 TO 64 DO collate[c-10]:=c;
FOR c:=91 TO 94 DO collate[c-36]:=c;
collate[59]:=96;
FOR c:=123 TO 126 DO collate[c-63]:=c;
collate[64]:=95;
FOR c:=97 TO 122 DO collate[c-32]:=c;
FOR c:=48 TO 57 DO collate[c+43]:=c;
{223}{TROUBLESHOOT:=TRUE;
DEBUGCYCLE:=1;
DEBUGSKIPPED:=0;
TRACING:=FALSE;
TROUBLESHOOT:=FALSE
DEBUGCYCLE:=99999;}
END;
{17}
PROCEDURE Openinput;
BEGIN
Reset(input,'','/E');
END;
{19}
FUNCTION Inputln:boolean;
LABEL
30;
BEGIN
IF Eof(input)THEN
Inputln:=false
ELSE
BEGIN
limit:=0;
buffer[0]:=xord[input↑];
IF buffer[0]=12 THEN Readln
ELSE
WHILE true DO
BEGIN
IF Eoln(input)AND(input↑<>Chr(26))AND(input↑<>Chr(27))THEN
BEGIN
buffer[limit]:=13;
Readln;
GOTO 30;
END;
IF limit=bufsize-1 THEN
BEGIN
buffer[limit]:=13;
BEGIN
Writeln(tty);
Write(tty,'! Input line too long');
END;
Error;
GOTO 30;
END;
limit:=limit+1;
Get(input);
IF Eof(input)THEN
BEGIN
buffer[limit]:=13;
GOTO 30;
END;
buffer[limit]:=xord[input↑];
END;
30:
Inputln:=true;
END;
END;
{34}
PROCEDURE Printid(p:namepointer);
VAR k:0..maxbytes;
BEGIN
IF p>=nameptr THEN Write(tty,'IMPOSSIBLE')
ELSE FOR k:=bytestart[p]TO bytestart[p+1]-1 DO Write(tty,xchr[bytemem[k]]);
END;
{37}
PROCEDURE Newxref(p:namepointer);
LABEL 10;
VAR
q:0..maxrefs;
m,n:sixteenbits;
BEGIN
IF((ilk[p]>3)OR(bytestart[p]+1=bytestart[p+1]))
AND(xrefswitch=0) THEN GOTO 10;
m:=modulecount+xrefswitch;
xrefswitch:=0;
q:=xref[p];
IF q>0 THEN
BEGIN
n:=xmem[q].numfield;
IF(n=m)OR(n=m+10240)THEN GOTO 10
ELSE
IF m=n+10240 THEN
BEGIN
xmem[q].
numfield:=m;
GOTO 10;
END;
END;
IF xrefptr=maxrefs THEN
BEGIN
Writeln(tty);
Write(tty,'! Sorry, ','cross reference',' capacity exceeded');
Error;
Quit;
END
ELSE
BEGIN
xrefptr:=xrefptr+1;
xmem[xrefptr].numfield:=m;
END;
xmem[xrefptr].xlinkfield:=q;
xref[p]:=xrefptr;
10:
END;
{38}PROCEDURE Newmodxref(p:namepointer);
VAR q,r:0..maxrefs;
BEGIN
q:=xref[p];
r:=0;
IF q>0 THEN
BEGIN
IF modxrefswitc=0 THEN
WHILE xmem[q].numfield>=10240
DO
BEGIN
r:=q;
q:=xmem[q].xlinkfield;
END
ELSE
IF xmem[q].numfield>=10240 THEN
BEGIN
r:=q;
q:=xmem[q].xlinkfield;
END;
END;
IF xrefptr=maxrefs THEN
BEGIN
Writeln(tty);
Write(tty,'! Sorry, ','cross reference',' capacity exceeded');
Error;
Quit;
END
ELSE
BEGIN
xrefptr:=xrefptr+1;
xmem[xrefptr].numfield:=modulecount+modxrefswitc;
END;
xmem[xrefptr].xlinkfield:=q;
modxrefswitc:=0;
IF r=0 THEN xref[p]:=xrefptr
ELSE xmem[r].xlinkfield:=xrefptr;
END;
{45}
FUNCTION Idlookup(t:eightbits):namepointer;
LABEL 31,32;
VAR
i:0..longbufsize;
h:0..hashsize;
k:0..maxbytes;
l:0..longbufsize;
p,q:namepointer;
BEGIN
l:=idloc-idfirst;
{46}h:=buffer[idfirst];
i:=idfirst+1;
WHILE i<idloc DO
BEGIN
h:=(h+h+buffer[i])MOD hashsize;
i:=i+1;
END;
{47}p:=hash[h];
WHILE p<>0 DO
BEGIN
IF(bytestart[p+1]-bytestart[p]=l)
AND((ilk[p]=t)OR((t=0)AND(ilk[p]>3)))THEN
{48}
BEGIN
i:=idfirst;
k:=bytestart[p];
WHILE(i<idloc)AND(buffer[i]=bytemem[k])DO
BEGIN
i:=i+1;
k:=k+1;
END;
IF i=idloc THEN
GOTO 31;
END;
p:=link[p];
END;
p:=nameptr;
link[p]:=hash[h];
hash[h]:=p;
31:;
IF p=nameptr THEN
{49}
BEGIN
IF byteptr+l>maxbytes THEN
BEGIN
Writeln(tty);
Write(tty,'! Sorry, ','byte memory',' capacity exceeded');
Error;
Quit;
END;
IF nameptr=maxnames THEN
BEGIN
Writeln(tty);
Write(tty,'! Sorry, ','name',' capacity exceeded');
Error;
Quit;
END;
i:=idfirst;
k:=byteptr;
WHILE i<idloc DO
BEGIN
bytemem[k]:=buffer[i];
k:=k+1;
i:=i+1;
END;
byteptr:=k;
nameptr:=nameptr+1;
bytestart[nameptr]:=k;
ilk[p]:=t;
xref[p]:=0;
END;
Idlookup:=p;
END;
{53}
FUNCTION Modlookup(l:sixteenbits):namepointer;
LABEL 31;
VAR
c:(less,equal,greater,prefix,extension);
j:0..longestname;
k:0..maxbytes;
p:namepointer;
q:namepointer;
BEGIN
c:=greater;
q:=0;
p:=ilk[0];
WHILE p<>0 DO
BEGIN{55}
BEGIN
k:=bytestart[p];
c:=equal;
j:=1;
WHILE(k<bytestart[p+1])AND(j<=l)AND(module[j]=bytemem[k])DO
BEGIN
k:=k+1;
j:=j+1;
END;
IF k=bytestart[p+1]THEN
IF j>l THEN c:=equal ELSE c:=extension
ELSE IF j>l THEN c:=prefix
ELSE
IF module[j]<bytemem[k]THEN c:=less
ELSE
c:=greater;
END;
q:=p;
IF c=less THEN
p:=link[q]
ELSE
IF c=greater THEN
p:=ilk[q]
ELSE
GOTO 31;
END;
{54}
IF byteptr+l>maxbytes THEN
BEGIN
Writeln(tty);
Write(tty,'! Sorry, ','byte memory',' capacity exceeded');
Error;
Quit;
END;
IF nameptr=maxnames THEN
BEGIN
Writeln(tty);
Write(tty,'! Sorry, ','name',' capacity exceeded');
Error;
Quit;
END;
p:=nameptr;
IF c=less THEN link[q]:=p
ELSE ilk[q]:=p;
link[p]:=0;
ilk[p]:=0;
xref[p]:=0;
c:=equal;
FOR j:=1 TO l DO bytemem[byteptr+j-1]:=module[j];
byteptr:=byteptr+l;
nameptr:=nameptr+1;
bytestart[nameptr]:=byteptr;
31:
IF c<>equal THEN
BEGIN
BEGIN
IF NOT phaseone THEN
BEGIN
Writeln(tty);
Write(tty,'! Incompatible module names');
Error;
END;
END;
p:=0;
END;
Modlookup:=p;
END;
{56}
FUNCTION Prefixlookup(l:sixteenbits):namepointer;
LABEL 31;
VAR
c:(less,equal,greater,prefix,extension);
count:0..maxnames;
j:0..longestname;
k:0..maxbytes;
p:namepointer;
q:namepointer;
r:namepointer;
BEGIN
q:=0;
p:=ilk[0];
count:=0;
r:=0;
WHILE p<>0 DO
BEGIN{55}
BEGIN
k:=bytestart[p];
c:=equal;
j:=1;
WHILE(k<bytestart[p+1])AND(j<=l)AND(module[j]=bytemem[k])DO
BEGIN
k:=k+1;
j:=j+1;
END;
IF k=bytestart[p+1]THEN
IF j>l THEN c:=equal
ELSE c:=extension
ELSE
IF j>l THEN c:=prefix
ELSE
IF module[j]<bytemem[k]THEN c:=less
ELSE c:=greater;
END;
IF c=less THEN p:=link[p]
ELSE
IF c=greater THEN p:=ilk[p]
ELSE
BEGIN
r:=p;
count:=count+1;
q:=ilk[p];
p:=link[p];
END;
IF p=0 THEN
BEGIN
p:=q;
q:=0;
END;
END;
IF count<>1 THEN
IF count=0 THEN
BEGIN
IF NOT phaseone THEN
BEGIN
Writeln(tty);
Write(tty,'! Name does not match');
Error;
END;
END
ELSE
BEGIN
IF NOT phaseone THEN
BEGIN
Writeln(tty);
Write(tty,'! Ambiguous prefix');
Error;
END;
END;
Prefixlookup:=r;
END;
{59}
PROCEDURE Resetinput;
BEGIN
Openinput;
page:=0;
line:=0;
limit:=0;
loc:=1;
buffer[0]:=32;
inputhasende:=false;
END;
{60}
PROCEDURE Getline;
BEGIN
IF buffer[0]=12 THEN
line:=0;
IF Inputln THEN
BEGIN
IF line=0 THEN
BEGIN
page:=page+1;
{63}{IF(PAGE=1)AND(LIMIT=29)THEN
IF(BUFFER[0]=67)AND(BUFFER[8]=22)THEN
BEGIN
REPEAT IF INPUTLN THEN ELSE
BEGIN
LIMIT:=0;
BUFFER[0]:=12;
END;
UNTIL BUFFER[0]=12;
OMITPAGE:=TRUE;
END};
END;
IF buffer[limit]=13 THEN buffer[limit]:=32;
END
ELSE
IF buffer[0]<>12 THEN
BEGIN
limit:=0;
buffer[0]:=12;
END
ELSE
inputhasende:=true;
line:=line+1;
loc:=0;
END;
{65}
FUNCTION Controlcode(c:asciicode):eightbits;
BEGIN
CASE c OF
64:Controlcode:=64;
39:Controlcode:=12;
32,9,42:Controlcode:=145;
68,100:Controlcode:=141;
70,102:Controlcode:=140;
123:Controlcode:=9;
125:Controlcode:=10;
80,112:Controlcode:=142;
38:Controlcode:=127;
60:Controlcode:=143;
62:BEGIN
BEGIN
IF NOT phaseone THEN
BEGIN
Writeln(tty);
Write(tty,'! Extra @>');
Error;
END;
END;
Controlcode:=0;
END;
84,116:Controlcode:=134;
33:Controlcode:=126;
63:Controlcode:=125;
94:Controlcode:=131;
58:Controlcode:=132;
46:Controlcode:=133;
44:Controlcode:=135;
47:Controlcode:=136;
35:Controlcode:=137;
43:Controlcode:=138;
59:Controlcode:=139;
{66}{48:BEGIN
TRACING:=FALSE;
CONTROLCODE:=0;
END;
49:BEGIN
TRACING:=TRUE;
CONTROLCODE:=0;
END;};
OTHERS:BEGIN
BEGIN
IF NOT phaseone THEN
BEGIN
Writeln(tty);
Write(tty,'! Unknown control code');
Error;
END;
END;
Controlcode:=0;
END
END;
END;
{67}PROCEDURE Skiplimbo;
LABEL 10;
VAR c:asciicode;
BEGIN
WHILE true DO
IF loc>limit THEN
BEGIN
Getline;
IF buffer[0]=12 THEN
IF inputhasende THEN GOTO 10
ELSE loc:=1;
END
ELSE
BEGIN
buffer[limit+1]:=64;
WHILE buffer[loc]<>64 DO loc:=loc+1;
IF loc<=limit THEN
BEGIN
loc:=loc+2;
c:=buffer[loc-1];
IF(c=32)OR(c=9)OR(c=42)THEN GOTO 10;
END;
END;
10:
END;
{68}
FUNCTION Skiptex:eightbits;
LABEL 30;
VAR c:eightbits;
BEGIN
WHILE true DO
BEGIN
IF loc>limit THEN
BEGIN
Getline;
IF buffer[0]=12 THEN
BEGIN
loc:=1;
c:=144;
GOTO 30;
END;
END;
buffer[limit+1]:=64;
REPEAT
c:=buffer[loc];
loc:=loc+1;
IF c=124 THEN GOTO 30;
UNTIL c=64;
IF loc<=limit THEN
BEGIN
c:=Controlcode(buffer[loc]);
loc:=loc+1;
GOTO 30;
END;
END;
30:
Skiptex:=c;
END;
{69}
FUNCTION Skipcomment(bal:eightbits):eightbits;
LABEL 30;
VAR c:asciicode;
BEGIN
WHILE true DO
BEGIN
IF loc>limit THEN
BEGIN
Getline;
IF buffer[0]=12 THEN
BEGIN
loc:=1;
bal:=0;
GOTO 30;
END;
END;
c:=buffer[loc];
loc:=loc+1;
IF c=124 THEN
GOTO 30;
{70}
IF c=64 THEN
BEGIN
c:=buffer[loc];
IF(c<>32)AND(c<>9)AND(c<>42)THEN loc:=loc+1
ELSE
BEGIN
loc:=loc-1;
bal:=0;
GOTO 30;
END
END
ELSE
IF(c=92)AND(buffer[loc]<>64)THEN loc:=loc+1
ELSE
IF c=123 THEN bal:=bal+1
ELSE
IF c=125 THEN
BEGIN
bal:=bal-1;
IF bal=0 THEN GOTO 30;
END;
END;
30:
Skipcomment:=bal;
END;
{72}
FUNCTION Getnext:eightbits;
LABEL 20,30;
VAR
c:eightbits;
d:eightbits;
j,k:0..longestname;
BEGIN
20:
IF loc>limit THEN Getline;
c:=buffer[loc];
loc:=loc+1;
CASE c OF
65,66,67,68,69,70,71,72,73,74
,75,76,77,78,79,80,81,82,83,84,85
,86,87,88,89,90,97,98,99,100,101,
102,103,104,105,106,107,108,109,110,111
,112,113,114,115,116,117,118,119,120,121,122:{74}BEGIN
IF((c=69)OR(c=101
))AND(loc>1)THEN
IF(buffer[loc-2]<=57)AND(buffer[loc-2]>=48)THEN c:=128;
IF c<>128 THEN
BEGIN
loc:=loc-1;
idfirst:=loc;
REPEAT
loc:=loc+1;
d:=buffer[loc];
UNTIL((d<48)OR((d>57)AND(d<65))OR((d>90)
AND(d<97))OR(d>122))AND(d<>95);
c:=130;
idloc:=loc;
END;
END;
39,34:{75}BEGIN
idfirst:=loc-1;
REPEAT
d:=buffer[loc];
loc:=loc+1;
IF loc>limit THEN
BEGIN
BEGIN
IF NOT phaseone THEN
BEGIN
Writeln(tty);
Write(tty,'! String constant didn''t end');
Error;
END;
END;
loc:=limit;
d:=c;
END;
UNTIL d=c;
idloc:=loc;
c:=129;
END;
64:{76}BEGIN
c:=Controlcode(buffer[loc]);
loc:=loc+1;
IF c=126 THEN
BEGIN
xrefswitch:=10240;
GOTO 20;
END
ELSE
IF c=125 THEN
BEGIN
xrefswitch:=0;
GOTO 20;
END
ELSE
IF(c<=134)AND(c>=131)THEN
{82}
BEGIN
idfirst:=loc;
buffer[limit+1]:=64;
WHILE buffer[loc]<>64 DO loc:=loc+1;
idloc:=loc;
IF loc>limit THEN
BEGIN
BEGIN
IF NOT phaseone THEN
BEGIN
Writeln(tty);
Write(tty,'! Control text didn''t end');
Error;
END;
END;
loc:=limit;
END
ELSE
BEGIN
loc:=loc+2;
IF buffer[loc-1]<>62 THEN
BEGIN
IF NOT phaseone THEN
BEGIN
Writeln(tty);
Write(tty,'! Control codes are forbidden in control text');
Error;
END;
END;
END;
END
ELSE IF c=143 THEN
{77}
BEGIN{79}
k:=0;
WHILE true DO
BEGIN
IF loc>limit THEN
BEGIN
Getline;
IF buffer[0]=12 THEN
BEGIN
BEGIN
IF NOT phaseone THEN
BEGIN
Writeln(tty);
Write(tty,'! Page ended in module name');
Error;
END;
END;
loc:=1;
GOTO 30;
END;
END;
d:=buffer[loc];
{80}
IF d=64 THEN
BEGIN
d:=buffer[loc+1];
IF d=62 THEN
BEGIN
loc:=loc+2;
GOTO 30;
END;
IF(d=32)OR(d=9)OR(d=42)THEN
BEGIN
BEGIN
IF NOT phaseone THEN
BEGIN
Writeln(tty);
Write(tty,'! Module name didn''t end');
Error;
END;
END;
GOTO 30;
END;
k:=k+1;
module[k]:=64;
loc:=loc+1;
END;
loc:=loc+1;
IF k<longestname-1 THEN
k:=k+1;
IF(d=32)OR(d=9)THEN
BEGIN
d:=32;
IF module[k-1]=32 THEN
k:=k-1;
END;
module[k]:=d;
END;
30:{81}
IF k>=longestname-2 THEN
BEGIN
BEGIN
Writeln(tty);
Write(tty,'! Module name too long: ');
END;
FOR j:=1 TO 25 DO Write(tty,xchr[module[j]]);
Write(tty,'...');
END;
IF(module[k]=32)AND(k>0)THEN
k:=k-1;
;
IF k>3 THEN
BEGIN
IF(module[k]=46)AND(module[k-1]=46)AND(module[k-2]=46)
THEN
curmodule:=Prefixlookup(k-3)
ELSE
curmodule:=Modlookup(k);
END
ELSE
curmodule:=Modlookup(k);
END;
END;
{73}46:IF buffer[loc]=46 THEN
BEGIN
c:=32;
loc:=loc+1;
END
ELSE
IF buffer[loc]=41 THEN
BEGIN
c:=93;
loc:=loc+1;
END;
58:IF buffer[loc]=61 THEN
BEGIN
c:=24;
loc:=loc+1;
END;
61:IF buffer[loc]=61 THEN
BEGIN
c:=30;
loc:=loc+1;
END;
62:IF buffer[loc]=61 THEN
BEGIN
c:=29;
loc:=loc+1;
END;
60:IF buffer[loc]=61 THEN
BEGIN
c:=28;
loc:=loc+1;
END
ELSE
IF buffer[loc]=62 THEN
BEGIN
c:=26;
loc:=loc+1;
END;
40:IF buffer[loc]=42 THEN
BEGIN
c:=9;
loc:=loc+1;
END
ELSE
IF buffer[loc]=46 THEN
BEGIN
c:=91;
loc:=loc+1;
END;
42:IF buffer[loc]=41 THEN
BEGIN
c:=10;
loc:=loc+1;
END;
32,9:GOTO 20;
12:c:=144;
OTHERS:
END;
{IF TROUBLESHOOT THEN DEBUGHELP;}Getnext:=c;
END;
{86}PROCEDURE Pascalxref;
LABEL 10;
VAR p:namepointer;
BEGIN
WHILE nextcontrol<140 DO
BEGIN
IF(nextcontrol>=130)AND(nextcontrol<=133)THEN
BEGIN
p:=Idlookup(nextcontrol-130);
Newxref(p);
IF(ilk[p]=17)OR(ilk[p]=22)THEN xrefswitch:=10240;
END;
nextcontrol:=Getnext;
IF(nextcontrol=124)OR(nextcontrol=123)THEN GOTO 10;
END;
10:
END;
{87}
PROCEDURE Outerxref;
VAR bal:eightbits;
BEGIN
WHILE nextcontrol<140 DO
IF nextcontrol<>123 THEN
Pascalxref
ELSE
BEGIN
bal:=Skipcomment(1);
nextcontrol:=124;
WHILE bal>0 DO
BEGIN
Pascalxref;
IF nextcontrol=124 THEN
bal:=Skipcomment(bal)
ELSE
bal:=0;
END;
END;
END;
{94}
PROCEDURE Modcheck(p:namepointer);
BEGIN
IF p>0 THEN
BEGIN
Modcheck(link[p]);
curxref:=xref[p];
IF xmem[curxref].numfield<10240 THEN
BEGIN
BEGIN
Writeln(tty);
Write(tty,'! Never defined: <');
END;
Printid(p);
Write(tty,'>');
END;
WHILE xmem[curxref].numfield>=10240 DO
curxref:=xmem[curxref].xlinkfield;
IF curxref=0 THEN
BEGIN
BEGIN
Writeln(tty);
Write(tty,'! Never used: <');
END;
Printid(p);
Write(tty,'>');
END;
Modcheck(ilk[p]);
END;
END;
{97}
PROCEDURE Flushbuffer(b:eightbits);
VAR k:0..linelength;
BEGIN
IF outbuf[b]=32 THEN b:=b-1;
IF(b>0)OR(outline>1)THEN
BEGIN
FOR k:=1 TO b DO Write(xchr[outbuf[k]]);
Writeln('');
outline:=outline+1;
END;
IF b<outptr THEN
IF outbuf[b+1]=32 THEN b:=b+1;
IF b<outptr THEN
FOR k:=b+1 TO outptr DO outbuf[k-b]:=outbuf[k];
outptr:=outptr-b;
END;
{100}
PROCEDURE Writeendofpa;
BEGIN
IF outptr>0 THEN
Flushbuffer(outptr);
{IF OMITPAGE THEN OMITPAGE:=FALSE ELSE}
BEGIN
Write(xchr[12]);
outpage:=outpage+1;
outline:=1;
END;
END;
{103}
PROCEDURE Breakout;
LABEL 31;
VAR
k:0..linelength;
c,d:asciicode;
BEGIN
k:=outptr;
d:=outbuf[k];
WHILE d<>32 DO
BEGIN
k:=k-1;
c:=outbuf[k];
IF c=92 THEN
IF k=0 THEN
{104}
BEGIN
BEGIN
Writeln(tty);
Write(tty,'! Line had to be broken (output p.',outpage:0,',l.',outline:0
);
END;
Writeln(tty,'):');
FOR k:=1 TO outptr DO Write(tty,xchr[outbuf[k]]);
Writeln(tty);
k:=outptr;
c:=32;
END
ELSE
IF(((d<65)OR((d>90)AND(d<97))OR(d>122))AND(outbuf[k-1]<>92))
THEN
BEGIN
k:=k+1;
c:=32;
END;
d:=c;
END;
Flushbuffer(k);
END;
{106}
PROCEDURE Outval(v:sixteenbits);
VAR
k:0..5;
BEGIN
k:=0;
REPEAT
dig[k]:=v MOD 10;
v:=v DIV 10;
k:=k+1;
UNTIL v=0;
REPEAT
k:=k-1;
BEGIN
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=dig[k]+48;
END;
UNTIL k=0;
END;
{107}
PROCEDURE Outname(p:namepointer);
VAR k:0..maxbytes;
BEGIN
BEGIN
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=123;
END;
FOR k:=bytestart[curname]TO bytestart[curname+1]-1 DO
BEGIN
IF bytemem[k]=95 THEN
BEGIN
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=92;
END;
BEGIN
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=bytemem[k];
END;
END;
BEGIN
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=125;
END;
END;
{108}
PROCEDURE Copylimbo;
LABEL 10;
VAR c:asciicode;
BEGIN
WHILE true DO
IF loc>limit THEN
BEGIN
BEGIN
IF(outptr>0)OR(limit=0)THEN
Flushbuffer(outptr);
END;
Getline;
IF buffer[0]=12 THEN
BEGIN
IF inputhasende THEN GOTO 10;
Writeendofpa;
loc:=1;
END;
END
ELSE
BEGIN
buffer[limit+1]:=64;
{109}
WHILE buffer[loc]<>64 DO
BEGIN
BEGIN
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=buffer[loc];
END;
loc:=loc+1;
END;
IF loc<=limit THEN
BEGIN
loc:=loc+2;
c:=buffer[loc-1];
IF(c=32)OR(c=9)OR(c=42)THEN GOTO 10;
BEGIN
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=64;
END;
IF c<>64 THEN
BEGIN
IF NOT phaseone THEN
BEGIN
Writeln(tty);
Write(tty,'! Double @ required outside of modules');
Error;
END;
END;
END;
END;
10:
END;
{110}
FUNCTION Copytex:eightbits;
LABEL 30;
VAR c:eightbits;
BEGIN
WHILE true DO
BEGIN
IF loc>limit THEN
BEGIN
BEGIN
IF(outptr>0)OR(limit=0)THEN Flushbuffer(outptr);
END;
Getline;
IF buffer[0]=12 THEN
BEGIN
loc:=1;
c:=144;
GOTO 30;
END;
END;
buffer[limit+1]:=64;
{111}
REPEAT
c:=buffer[loc];
loc:=loc+1;
IF c=124 THEN
GOTO 30;
IF c<>64 THEN
BEGIN
BEGIN
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=c;
END;
IF(outptr=1)AND((c=32)OR(c=9))THEN
outptr:=outptr-1;
END;
UNTIL c=64;
IF loc<=limit THEN
BEGIN
c:=Controlcode(buffer[loc]);
loc:=loc+1;
GOTO 30;
END;
END;
30:
Copytex:=c;
END;
{112}
FUNCTION Copycomment(bal:eightbits):eightbits;
LABEL 30;
VAR c:asciicode;
BEGIN
WHILE true DO
BEGIN
IF loc>limit THEN
BEGIN
Getline;
IF buffer[0]=12 THEN
BEGIN
BEGIN
IF NOT phaseone THEN
BEGIN
Writeln(tty);
Write(tty,'! Page ended in mid-comment');
Error;
END;
END;
loc:=1;
{114}
BEGIN
IF tokptr+2>maxtoks THEN
BEGIN
Writeln(tty);
Write(tty,'! Sorry, ','token',' capacity exceeded');
Error;
Quit;
END;
tokmem[tokptr]:=32;
tokptr:=tokptr+1;
END;
REPEAT
BEGIN
IF tokptr+2>maxtoks THEN
BEGIN
Writeln(tty);
Write(tty,'! Sorry, ','token',' capacity exceeded');
Error;
Quit;
END;
tokmem[tokptr]:=125;
tokptr:=tokptr+1;
END;
bal:=bal-1;
UNTIL bal=0;
GOTO 30;
END;
END;
c:=buffer[loc];
loc:=loc+1;
IF c=124 THEN
GOTO 30;
BEGIN
IF tokptr+2>maxtoks THEN
BEGIN
Writeln(tty);
Write(tty,'! Sorry, ','token',' capacity exceeded');
Error;
Quit;
END;
tokmem[tokptr]:=c;
tokptr:=tokptr+1;
END;
{113}
IF c=64 THEN
BEGIN
loc:=loc+1;
IF buffer[loc-1]<>64 THEN
BEGIN
BEGIN
IF NOT phaseone THEN
BEGIN
Writeln
(tty);
Write(tty,'! Illegal use of @ in comment');
Error;
END;
END;
loc:=loc-2;
tokptr:=tokptr-1;
{114}
BEGIN
IF tokptr+2>maxtoks THEN
BEGIN
Writeln(tty);
Write(tty,'! Sorry, ','token',' capacity exceeded');
Error;
Quit;
END;
tokmem[tokptr]:=32;
tokptr:=tokptr+1;
END;
REPEAT
BEGIN
IF tokptr+2>maxtoks THEN
BEGIN
Writeln(tty);
Write(tty,'! Sorry, ','token',' capacity exceeded');
Error;
Quit;
END;
tokmem[tokptr]:=125;
tokptr:=tokptr+1;
END;
bal:=bal-1;
UNTIL bal=0;
GOTO 30;
END;
END
ELSE
IF(c=92)AND(buffer[loc]<>64)THEN
BEGIN
BEGIN
IF tokptr+2>maxtoks THEN
BEGIN
Writeln(tty);
Write(tty,'! Sorry, ','token',' capacity exceeded');
Error;
Quit;
END;
tokmem[tokptr]:=buffer[loc];
tokptr:=tokptr+1;
END;
loc:=loc+1;
END
ELSE
IF c=123 THEN bal:=bal+1
ELSE
IF c=125 THEN
BEGIN
bal:=bal-1;
IF bal=0 THEN GOTO 30;
END;
END;
30:
Copycomment:=bal;
END;
{116}{PROCEDURE PRINTCAT(C:EIGHTBITS);
BEGIN
CASE C OF
1:WRITE(TTY,'simp');
2:WRITE(TTY,'math');
3:WRITE(TTY,'intro');
4:WRITE(TTY,'open');
5:WRITE(TTY,'beginning');
6:WRITE(TTY,'close');
7:WRITE(TTY,'alpha');
8:WRITE(TTY,'omega');
9:WRITE(TTY,'semi');
10:WRITE(TTY,'terminator');
11:WRITE(TTY,'stmt');
12:WRITE(TTY,'cond');
13:WRITE(TTY,'clause');
14:WRITE(TTY,'colon');
15:WRITE(TTY,'exp');
16:WRITE(TTY,'proc');
17:WRITE(TTY,'casehead');
18:WRITE(TTY,'recordhead');
19:WRITE(TTY,'varhead');
20:WRITE(TTY,'elsie');
21:WRITE(TTY,'casey');
22:WRITE(TTY,'module');
OTHERS:WRITE(TTY,'UNKNOWN')
END;
END;}
{122}{PROCEDURE PRINTTEXT(P:TEXTPOINTER);
VAR J:0..MAXTOKS;R:0..10239;
BEGIN
IF P>=TEXTPTR THEN WRITE(TTY,'BAD')
ELSE FOR J:=TOKSTART[P]TO TOKSTART[P+1]-1 DO
BEGIN
R:=TOKMEM[J]MOD 10240;
CASE TOKMEM[J]DIV 10240 OF
1:
BEGIN
WRITE(TTY,'\\',XCHR[123]);
PRINTID(R);
WRITE(TTY,XCHR[125]);
END;
2:
BEGIN
WRITE(TTY,'\&',XCHR[123]);
PRINTID(R);
WRITE(TTY,XCHR[125]);
END;
3:
BEGIN
WRITE(TTY,'<');
PRINTID(R);
WRITE(TTY,'>');
END;
4:WRITE(TTY,'[[',R:0,']]');
5:WRITE(TTY,'|[[',R:0,']]|');
OTHERS:[123]CASE R OF
131:WRITE(TTY,'\mathbin',XCHR[123]);
132:WRITE(TTY,'\mathrel',XCHR[123]);
133:WRITE(TTY,'\mathop',XCHR[123]);
134:WRITE(TTY,'[ccancel]');
135:WRITE(TTY,'[cancel]');
136:WRITE(TTY,'[indent]');
137:WRITE(TTY,'[outdent]');
139:WRITE(TTY,'[backup]');
138:WRITE(TTY,'[opt]');
140:WRITE(TTY,'[break]');
141:WRITE(TTY,'[force]');
142:WRITE(TTY,'[fforce]');
143:WRITE(TTY,'[quit]');
OTHERS:WRITE(TTY,XCHR[R])
END
END;
END;
END;}
{147}
PROCEDURE Red(j:sixteenbits; k:eightbits; c:eightbits; d:integer);
VAR i:0..maxscraps;
BEGIN
cat[j]:=c;
trans[j]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
IF k>1 THEN
BEGIN
FOR i:=j+k TO loptr DO
BEGIN
cat[i-k+1]:=cat[i];
trans[i-k+1]:=trans[i];
END;
loptr:=loptr-k+1;
END;
{148}
IF pp+d>=scrapbase THEN :p:=pp+d
ELSE pp:=scrapbase;
END;
{149}
PROCEDURE Sq(j:sixteenbits; k:eightbits; c:eightbits; d:integer);
VAR i:0..maxscraps;
BEGIN
IF k=1 THEN
BEGIN
cat[j]:=c;
{148}
IF pp+d>=scrapbase THEN pp:=pp+d
ELSE pp:=scrapbase;
END
ELSE
BEGIN
FOR i:=j TO j+k-1 DO
BEGIN
tokmem[tokptr]:=40960+trans[i];
tokptr:=tokptr+1;
END;
Red(j,k,c,d);
END;
END;
{153}{PROCEDURE PROD(N:EIGHTBITS);
VAR K:1..MAXSCRAPS;
BEGIN
IF TRACING THEN
BEGIN
BEGIN
WRITELN(TTY);
WRITE(TTY,N:0,':');
END;
FOR K:=SCRAPBASE TO LOPTR DO
BEGIN
IF K=PP THEN WRITE(TTY,'*')
ELSE WRITE(TTY,' ');
PRINTCAT(CAT[K]);
END;
IF HIPTR<=SCRAPPTR THEN WRITE(TTY,'...');
END;
END;}
{154}
FUNCTION Translate:textpointer;
LABEL 30,31;
VAR
i:1..maxscraps;
k:0..longbufsize;
BEGIN
pp:=scrapbase;
loptr:=pp-1;
hiptr:=pp;
{157}{IF TRACING THEN
BEGIN
BEGIN
WRITELN(TTY);
WRITE(TTY,'Tracing after p.',PAGE:0,',l.',LINE:0,':');END;
IF LOC>50 THEN
BEGIN
WRITE(TTY,'...');
FOR K:=LOC-50 TO LOC DO WRITE(TTY,XCHR[BUFFER[K-1]]);
END
ELSE FOR K:=1 TO LOC DO WRITE(TTY,XCHR[BUFFER[K-1]]);
END};
{150}
WHILE true DO
BEGIN{151}
IF loptr<pp+3 THEN
BEGIN
REPEAT
IF hiptr<=scrapptr THEN
BEGIN
loptr:=loptr+1;
cat[loptr]:=cat[hiptr];
trans[loptr]:=trans[hiptr];
hiptr:=hiptr+1;
END;
UNTIL(hiptr>scrapptr)OR(loptr=pp+3);
FOR i:=loptr+1 TO pp+3 DO cat[i]:=0;
END;
IF(tokptr+8>maxtoks)OR(textptr+4>maxtexts)THEN
BEGIN
Writeln(tty);
Write(tty,'! Sorry, ','token',' capacity exceeded');
Error;
Quit;
END;
IF pp>loptr THEN GOTO 30;
{125}
CASE cat[pp]OF
7:{126}IF cat[pp+1]=2 THEN
BEGIN
IF cat[pp+2]=14
THEN
BEGIN
Sq(pp+1,2,2,0);
{PROD(1)};
GOTO 31;
END
ELSE
IF cat[pp+2]=8 THEN
BEGIN
tokmem[tokptr]:=40960+trans[pp];
tokptr:=tokptr+1;
tokmem[tokptr]:=32;
tokptr:=tokptr+1;
tokmem[tokptr]:=36;
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+1];
tokptr:=tokptr+1;
tokmem[tokptr]:=36;
tokptr:=tokptr+1;
tokmem[tokptr]:=32;
tokptr:=tokptr+1;
tokmem[tokptr]:=136;
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+2];
tokptr:=tokptr+1;
Red(pp,3,13,-1);
{PROD(2)};
GOTO 31;
;
END;
END
ELSE
IF cat[pp+1]=8 THEN
BEGIN
tokmem[tokptr]:=40960+trans[pp];
tokptr:=tokptr+1;
tokmem[tokptr]:=32;
tokptr:=tokptr+1;
tokmem[tokptr]:=136;
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+1];
tokptr:=tokptr+1;
Red(pp,2,13,-1);
{PROD(3)};
GOTO 31;
END
ELSE
IF cat[pp+1]=1 THEN
BEGIN
Sq(pp+1,1,2,0);
{PROD(4)};
GOTO 31;
END;
5:{127}IF cat[pp+1]=6 THEN
BEGIN
IF(cat[pp+2]=10)OR(cat[pp+2]=11)THEN
BEGIN
Sq(pp,3,11,-2);
{PROD(5)};
GOTO 31;
END;
END
ELSE
IF cat[pp+1]=11 THEN
BEGIN
tokmem[tokptr]:=40960+trans[pp];
tokptr:=tokptr+1;
tokmem[tokptr]:=140;
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+1];
tokptr:=tokptr+1;
Red(pp,2,5,0);
{PROD(6)};
GOTO 31;
END;
17:{128}IF cat[pp+1]=21 THEN
BEGIN
IF cat[pp+2]=13 THEN
BEGIN
tokmem[tokptr]:=40960+trans[pp];
tokptr:=tokptr+1;
tokmem[tokptr]:=137;
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+1];
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+2];
tokptr:=tokptr+1;
Red(pp,3,17,0);
{PROD(7)};
GOTO 31;
END;
END
ELSE
IF cat[pp+1]=6 THEN
BEGIN
IF cat[pp+2]=10 THEN
BEGIN
tokmem[tokptr]:=40960+trans[pp];
tokptr:=tokptr+1;
tokmem[tokptr]:=135;
tokptr:=tokptr+1;
tokmem[tokptr]:=137;
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+1];
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+2];
tokptr:=tokptr+1;
Red(pp,3,11,-2);
{PROD(8)};
GOTO 31;
END;
END
ELSE
IF cat[pp+1]=11 THEN
BEGIN
tokmem[tokptr]:=40960+trans[pp];
tokptr:=tokptr+1;
tokmem[tokptr]:=141;
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+1];
tokptr:=tokptr+1;
Red(pp,2,17,0);
{PROD(9)};
GOTO 31;
END;
21:{129}IF cat[pp+1]=13 THEN
BEGIN
Sq(pp,2,17,0);
{PROD(10)};
GOTO 31;
END;
13:{130}IF cat[pp+1]=11 THEN
BEGIN
tokmem[tokptr]:=40960+trans[pp];
tokptr:=tokptr+1;
tokmem[tokptr]:=140;
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+1];
tokptr:=tokptr+1;
tokmem[tokptr]:=135;
tokptr:=tokptr+1;
tokmem[tokptr]:=137;
tokptr:=tokptr+1;
tokmem[tokptr]:=141;
tokptr:=tokptr+1;
Red(pp,2,11,-2);
{PROD(11)};
GOTO 31;
END;
12:{131}IF(cat[pp+1]=13)AND(cat[pp+2]=11)THEN
IF cat[pp+3]=20 THEN
BEGIN
tokmem[tokptr]:=40960+trans[pp];
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+1];
tokptr:=tokptr+1;
tokmem[tokptr]:=140;
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+2];
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+3];
tokptr:=tokptr+1;
tokmem[tokptr]:=32;
tokptr:=tokptr+1;
tokmem[tokptr]:=135;
tokptr:=tokptr+1;
Red(pp,4,13,-2);
{PROD(12)};
GOTO 31;
END
ELSE
BEGIN
tokmem[tokptr]:=40960+trans[pp];
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+1];
tokptr:=tokptr+1;
tokmem[tokptr]:=140;
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+2];
tokptr:=tokptr+1;
tokmem[tokptr]:=135;
tokptr:=tokptr+1;
tokmem[tokptr]:=137;
tokptr:=tokptr+1;
tokmem[tokptr]:=141;
tokptr:=tokptr+1;
Red(pp,3,11,-2);
{PROD(13)};
GOTO 31;
END;
20:{132}BEGIN
Sq(pp,1,3,-3);
{PROD(14)};
GOTO 31;
END;
15:{133}IF cat[pp+1]=2 THEN
BEGIN
IF cat[pp+2]=1 THEN
BEGIN
tokmem[tokptr]:=40960+trans[pp];
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+1];
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+2];
tokptr:=tokptr+1;
tokmem[tokptr]:=125;
tokptr:=tokptr+1;
Red(pp,3,2,-1);
{PROD(15)};
GOTO 31;
END;
END
ELSE
IF cat[pp+1]=1 THEN
BEGIN
tokmem[tokptr]:=40960+trans[pp];
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+1];
tokptr:=tokptr+1;
tokmem[tokptr]:=125;
tokptr:=tokptr+1;
Red(pp,2,2,-1);
{PROD(16)};
GOTO 31;
END;
3:{134}IF cat[pp+1]=11 THEN
BEGIN
tokmem[tokptr]:=40960+trans[pp];
tokptr:=tokptr+1;
tokmem[tokptr]:=32;
tokptr:=tokptr+1;
tokmem[tokptr]:=138;
tokptr:=tokptr+1;
tokmem[tokptr]:=55;
tokptr:=tokptr+1;
tokmem[tokptr]:=135;
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+1];
tokptr:=tokptr+1;
Red(pp,2,11,-2);
{PROD(17)};
GOTO 31;
END;
2:{135}IF cat[pp+1]=14 THEN
BEGIN
tokmem[tokptr]:=141;
tokptr:=tokptr+1;
tokmem[tokptr]:=139;
tokptr:=tokptr+1;
tokmem[tokptr]:=36;
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp];
tokptr:=tokptr+1;
tokmem[tokptr]:=36;
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+1];
tokptr:=tokptr+1;
Red(pp,2,3,-3);
{PROD(18)};
GOTO 31;
END
ELSE
IF cat[pp+1]=2 THEN
BEGIN
Sq(pp,2,2,-1);
{PROD(19)};
GOTO 31;
END
ELSE
IF cat[pp+1]=1 THEN
BEGIN
Sq(pp,2,2,-1);
{PROD(20)};
GOTO 31;
END
ELSE
IF cat[pp+1]=10 THEN
BEGIN
tokmem[tokptr]:=36;
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp];
tokptr:=tokptr+1;
tokmem[tokptr]:=36;
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+1];
tokptr:=tokptr+1;
Red(pp,2,11,-2);
{PROD(21)};
GOTO 31;
END;
22:{136}IF(cat[pp+1]=10)OR(cat[pp+1]=9)THEN
BEGIN
tokmem[tokptr]:=40960+
trans[pp];
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+1];
tokptr:=tokptr+1;
tokmem[tokptr]:=141;
tokptr:=tokptr+1;
Red(pp,2,11,-2);
{PROD(22)};
GOTO 31;
END
ELSE
BEGIN
Sq(pp,1,1,-2);
{PROD(23)};
GOTO 31;
END;
4:{137}IF cat[pp+1]=21 THEN
BEGIN
tokmem[tokptr]:=40960+trans[pp];
tokptr:=tokptr+1;
tokmem[tokptr]:=135;
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+1];
tokptr:=tokptr+1;
Red(pp,2,21,-2);
{PROD(24)};
GOTO 31;
END
ELSE
IF cat[pp+1]=6 THEN
BEGIN
tokmem[tokptr]:=40960+trans[pp];
tokptr:=tokptr+1;
tokmem[tokptr]:=92;
tokptr:=tokptr+1;
tokmem[tokptr]:=44;
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+1];
tokptr:=tokptr+1;
Red(pp,2,2,-1);
{PROD(25)};
GOTO 31;
END
ELSE
IF cat[pp+1]=2 THEN
{138}
BEGIN
IF cat[pp+2]=21 THEN
BEGIN
Sq(pp,3,21,-2);
{PROD(26)};
GOTO 31;
END
ELSE
IF cat[pp+2]=6 THEN
BEGIN
Sq(pp,3,2,-1);
{PROD(27)};
GOTO 31;
END
ELSE
IF cat[pp+2]=14 THEN
BEGIN
Sq(pp+1,2,2,0);
{PROD(28)};
GOTO 31;
END
ELSE
IF cat[pp+2]=16 THEN
BEGIN
IF cat[pp+3]=3 THEN
BEGIN
tokmem[tokptr]:=40960+trans[pp+1];
tokptr:=tokptr+1;
tokmem[tokptr]:=133;
tokptr:=tokptr+1;
tokmem[tokptr]:=135;
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+2];
tokptr:=tokptr+1;
tokmem[tokptr]:=125;
tokptr:=tokptr+1;
Red(pp+1,3,2,0);
{PROD(29)};
GOTO 31;
END;
END
ELSE
IF cat[pp+2]=9 THEN
BEGIN
tokmem[tokptr]:=40960+trans[pp+1];
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+2];
tokptr:=tokptr+1;
tokmem[tokptr]:=92;
tokptr:=tokptr+1;
tokmem[tokptr]:=44;
tokptr:=tokptr+1;
tokmem[tokptr]:=138;
tokptr:=tokptr+1;
tokmem[tokptr]:=53;
tokptr:=tokptr+1;
Red(pp+1,2,2,0);
{PROD(30)};
GOTO 31;
END
ELSE
IF cat[pp+2]=19 THEN
BEGIN
IF cat[pp+3]=3 THEN
BEGIN
tokmem[tokptr]:=40960+trans[pp+1];
tokptr:=tokptr+1;
tokmem[tokptr]:=133;
tokptr:=tokptr+1;
tokmem[tokptr]:=135;
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+2];
tokptr:=tokptr+1;
tokmem[tokptr]:=125;
tokptr:=tokptr+1;
Red(pp+1,3,2,0);
{PROD(31)};
GOTO 31;
END;
END;
END
ELSE
IF cat[pp+1]=16 THEN
BEGIN
IF cat[pp+2]=3 THEN
BEGIN
tokmem[tokptr]:=133;
tokptr:=tokptr+1;
tokmem[tokptr]:=135;
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+1];
tokptr:=tokptr+1;
tokmem[tokptr]:=125;
tokptr:=tokptr+1;
Red(pp+1,2,2,0);
{PROD(32)};
GOTO 31;
END;
END
ELSE
IF cat[pp+1]=1 THEN
BEGIN
Sq(pp+1,1,2,0);
{PROD(33)};
GOTO 31;
END
ELSE
IF cat[pp+1]=19 THEN
BEGIN
IF cat[pp+2]=3 THEN
BEGIN
tokmem[tokptr]:=133;
tokptr:=tokptr+1;
tokmem[tokptr]:=135;
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+1];
tokptr:=tokptr+1;
tokmem[tokptr]:=125;
tokptr:=tokptr+1;
Red(pp+1,2,2,0);
{PROD(34)};
GOTO 31;
END;
END;
16:{139}IF cat[pp+1]=5 THEN
BEGIN
IF(cat[pp+2]=6)AND(cat[pp+3]=10)THEN
BEGIN
tokmem[tokptr]:=40960+trans[pp];
tokptr:=tokptr+1;
tokmem[tokptr]:=135;
tokptr:=tokptr+1;
tokmem[tokptr]:=137;
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+1];
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+2];
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+3];
tokptr:=tokptr+1;
Red(pp,4,11,-2);
{PROD(35)};
GOTO 31;
END;
END
ELSE
IF cat[pp+1]=11 THEN
BEGIN
tokmem[tokptr]:=40960+trans[pp];
tokptr:=tokptr+1;
tokmem[tokptr]:=140;
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+1];
tokptr:=tokptr+1;
Red(pp,2,16,-2);
{PROD(36)};
GOTO 31;
END;
18:{140}IF(cat[pp+1]=3)AND(cat[pp+2]=21)THEN
BEGIN
tokmem[tokptr]:=40960+trans[pp];
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+1];
tokptr:=tokptr+1;
tokmem[tokptr]:=32;
tokptr:=tokptr+1;
tokmem[tokptr]:=135;
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+2];
tokptr:=tokptr+1;
Red(pp,3,21,-2);
{PROD(37)};
GOTO 31;
END
ELSE
BEGIN
tokmem[tokptr]:=136;
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp];
tokptr:=tokptr+1;
tokmem[tokptr]:=135;
tokptr:=tokptr+1;
Red(pp,1,17,0);
{PROD(38)};
GOTO 31;
END;
9:{141}BEGIN
Sq(pp,1,10,-3);
{PROD(39)};
GOTO 31;
END;
1:{142}IF cat[pp+1]=14 THEN
BEGIN
tokmem[tokptr]:=141;
tokptr:=tokptr+1;
tokmem[tokptr]:=139;
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp];
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+1];
tokptr:=tokptr+1;
Red(pp,2,3,-3);
{PROD(40)};
GOTO 31;
END
ELSE
IF cat[pp+1]=2 THEN
BEGIN
Sq(pp,2,2,-1);
{PROD(41)};
GOTO 31;
END
ELSE
IF cat[pp+1]=22 THEN
BEGIN
Sq(pp,2,22,0);
{PROD(42)};
GOTO 31;
END
ELSE
IF cat[pp+1]=1 THEN
BEGIN
Sq(pp,2,1,-2);
{PROD(43)};
GOTO 31;
END
ELSE
IF cat[pp+1]=10 THEN
BEGIN
Sq(pp,2,11,-2);
{PROD(44)};
GOTO 31;
END;
11:{143}IF cat[pp+1]=11 THEN
BEGIN
tokmem[tokptr]:=40960+trans[pp];
tokptr:=tokptr+1;
tokmem[tokptr]:=140;
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+1];
tokptr:=tokptr+1;
Red(pp,2,11,-2);
{PROD(45)};
GOTO 31;
END;
10:{144}BEGIN
Sq(pp,1,11,-2);
{PROD(46)};
GOTO 31;
END;
19:{145}IF cat[pp+1]=5 THEN
BEGIN
Sq(pp,1,11,-2);
{PROD(47)};
GOTO 31;
END
ELSE
IF cat[pp+1]=2 THEN
BEGIN
IF cat[pp+2]=14 THEN
BEGIN
tokmem[tokptr]:=36;
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+1];
tokptr:=tokptr+1;
tokmem[tokptr]:=36;
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+2];
tokptr:=tokptr+1;
Red(pp+1,2,3,+1);
{PROD(48)};
GOTO 31;
END;
END
ELSE
IF cat[pp+1]=1 THEN
BEGIN
IF cat[pp+2]=14 THEN
BEGIN
Sq(pp+1,2,3,+1);
{PROD(49)};
GOTO 31;
END;
END
ELSE
IF cat[pp+1]=11 THEN
BEGIN
tokmem[tokptr]:=40960+trans[pp];
tokptr:=tokptr+1;
tokmem[tokptr]:=140;
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+1];
tokptr:=tokptr+1;
Red(pp,2,19,-2);
{PROD(50)};
GOTO 31;
END;
OTHERS:
END;
pp:=pp+1;
31:
END;
30:;
IF(loptr=scrapbase)AND(cat[loptr]<>2)THEN
Translate:=trans[loptr]
ELSE
{156}
BEGIN
FOR pp:=scrapbase TO loptr DO
BEGIN
IF pp<>scrapbase THEN
BEGIN
tokmem[tokptr]:=32;
tokptr:=tokptr+1;
END;
IF cat[pp]=2 THEN
BEGIN
tokmem[tokptr]:=36;
tokptr:=tokptr+1;
END;
tokmem[tokptr]:=40960+trans[pp];
tokptr:=tokptr+1;
IF cat[pp]=2 THEN
BEGIN
tokmem[tokptr]:=36;
tokptr:=tokptr+1;
END;
IF tokptr+6>maxtoks THEN
BEGIN
Writeln(tty);
Write(tty,'! Sorry, ','token',' capacity exceeded');
Error;
Quit;
END;
END;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
Translate:=textptr-1;
END;
END;
{158}{167}PROCEDURE Appcomment;
BEGIN
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
IF(scrapptr<scrapbase)OR(cat[scrapptr]<8)OR(cat[scrapptr]>10)THEN
BEGIN
scrapptr:=scrapptr+1;
cat[scrapptr]:=10;
trans[scrapptr]:=0;
END
ELSE
BEGIN
tokmem[tokptr]:=40960+trans[scrapptr];
tokptr:=tokptr+1;
END;
tokmem[tokptr]:=textptr+40959;
tokptr:=tokptr+1;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
PROCEDURE Pascalparse;
LABEL 21,10;
VAR
j:0..longbufsize;
p:namepointer;
BEGIN
WHILE nextcontrol<140 DO
BEGIN{160}
IF(scrapptr+4>maxscraps)OR(tokptr+6>maxtoks)OR(textptr+4>maxtexts)THEN
BEGIN
Writeln(tty);
Write(tty,'! Sorry, ','scrap',' capacity exceeded');
Error;
Quit;
END;
21:
CASE nextcontrol OF
6:BEGIN
tokmem[tokptr]:=92;
tokptr:=tokptr+1;
tokmem[tokptr]:=105;
tokptr:=tokptr+1;
tokmem[tokptr]:=110;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=2;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
32:BEGIN
tokmem[tokptr]:=92;
tokptr:=tokptr+1;
tokmem[tokptr]:=116;
tokptr:=tokptr+1;
tokmem[tokptr]:=111;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=2;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
129:{162}BEGIN
tokmem[tokptr]:=92;
tokptr:=tokptr+1;
tokmem[tokptr]:=46;
tokptr:=tokptr+1;
tokmem[tokptr]:=123;
tokptr:=tokptr+1;
j:=idfirst;
WHILE j<idloc DO
BEGIN
CASE buffer[j]OF
32,92,35,37,36,94,39,96,123,125,
126,38,95,24,14,1,22,26,11,29,28:BEGIN
tokmem[tokptr]:=92;
tokptr:=tokptr+1;
END;
64:IF buffer[j+1]=64 THEN j:=j+1
ELSE
BEGIN
IF NOT phaseone THEN
BEGIN
Writeln(tty);
Write(tty,'! Double @ should be used in strings');
Error;
END;
END;
25:;
OTHERS:IF buffer[j]<32 THEN
BEGIN
IF NOT phaseone THEN
BEGIN
Writeln(tty);
Write(tty,'! This character shouldn''t be used in strings');
Error;
END;
END
END;
BEGIN
IF tokptr+2>maxtoks THEN
BEGIN
Writeln(tty);
Write(tty,'! Sorry, ','token',' capacity exceeded');
Error;
Quit;
END;
tokmem[tokptr]:=buffer[j];
tokptr:=tokptr+1;
END;
j:=j+1;
END;
BEGIN
tokmem[tokptr]:=125;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=1;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
END;
35,36,37,94:BEGIN
tokmem[tokptr]:=92;
tokptr:=tokptr+1;
tokmem[tokptr]:=nextcontrol;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=2;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
0,124,131,132,133:;
40,91:BEGIN
tokmem[tokptr]:=nextcontrol;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=4;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
41,93:BEGIN
tokmem[tokptr]:=nextcontrol;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=6;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
42:BEGIN
tokmem[tokptr]:=92;
tokptr:=tokptr+1;
tokmem[tokptr]:=97;
tokptr:=tokptr+1;
tokmem[tokptr]:=115;
tokptr:=tokptr+1;
tokmem[tokptr]:=116;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=2;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
44:BEGIN
tokmem[tokptr]:=44;
tokptr:=tokptr+1;
tokmem[tokptr]:=138;
tokptr:=tokptr+1;
tokmem[tokptr]:=57;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=2;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
46,48,49,50,51,52,53,54,55,56,57:BEGIN
tokmem[tokptr]:=nextcontrol;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=1;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
59:BEGIN
tokmem[tokptr]:=59;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=9;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
58:BEGIN
tokmem[tokptr]:=58;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=14;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
{161}26:BEGIN
tokmem[tokptr]:=92;
tokptr:=tokptr+1;
tokmem[tokptr]:=73;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=2;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
28:BEGIN
tokmem[tokptr]:=92;
tokptr:=tokptr+1;
tokmem[tokptr]:=76;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=2;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
29:BEGIN
tokmem[tokptr]:=92;
tokptr:=tokptr+1;
tokmem[tokptr]:=71;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=2;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
30:BEGIN
tokmem[tokptr]:=92;
tokptr:=tokptr+1;
tokmem[tokptr]:=83;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=2;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
4:BEGIN
tokmem[tokptr]:=92;
tokptr:=tokptr+1;
tokmem[tokptr]:=87;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=2;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
31:BEGIN
tokmem[tokptr]:=92;
tokptr:=tokptr+1;
tokmem[tokptr]:=86;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=2;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
5:BEGIN
tokmem[tokptr]:=92;
tokptr:=tokptr+1;
tokmem[tokptr]:=82;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=2;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
24:BEGIN
tokmem[tokptr]:=92;
tokptr:=tokptr+1;
tokmem[tokptr]:=75;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=2;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
11:BEGIN
tokmem[tokptr]:=92;
tokptr:=tokptr+1;
tokmem[tokptr]:=94;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=2;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
130:{164}BEGIN
p:=Idlookup(0);
CASE ilk[p]OF
0:BEGIN
tokmem[tokptr]:=10240+p;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=1;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
4:BEGIN
tokmem[tokptr]:=20480+p;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=7;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
7:BEGIN
tokmem[tokptr]:=141;
tokptr:=tokptr+1;
tokmem[tokptr]:=139;
tokptr:=tokptr+1;
tokmem[tokptr]:=20480+p;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=3;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
8:BEGIN
tokmem[tokptr]:=131;
tokptr:=tokptr+1;
tokmem[tokptr]:=20480+p;
tokptr:=tokptr+1;
tokmem[tokptr]:=125;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=2;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
9:BEGIN
tokmem[tokptr]:=20480+p;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=8;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
12:BEGIN
tokmem[tokptr]:=141;
tokptr:=tokptr+1;
tokmem[tokptr]:=20480+p;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=7;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
13:BEGIN
tokmem[tokptr]:=20480+p;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=3;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
16:BEGIN
tokmem[tokptr]:=20480+p;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=1;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
20:BEGIN
tokmem[tokptr]:=132;
tokptr:=tokptr+1;
tokmem[tokptr]:=20480+p;
tokptr:=tokptr+1;
tokmem[tokptr]:=125;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=2;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
{165}5:BEGIN
BEGIN
tokmem[tokptr]:=141;
tokptr:=tokptr+1;
tokmem[tokptr]:=20480+p;
tokptr:=tokptr+1;
tokmem[tokptr]:=135;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=5;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
BEGIN
scrapptr:=scrapptr+1;
cat[scrapptr]:=3;
trans[scrapptr]:=0;
END;
END;
6:BEGIN
BEGIN
scrapptr:=scrapptr+1;
cat[scrapptr]:=21;
trans[scrapptr]:=0;
END;
BEGIN
tokmem[tokptr]:=141;
tokptr:=tokptr+1;
tokmem[tokptr]:=20480+p;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=7;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
END;
10:BEGIN{166}
IF(scrapptr<scrapbase)OR((cat[scrapptr]<>10)
AND(cat[scrapptr]<>9))THEN
BEGIN
scrapptr:=scrapptr+1;
cat[scrapptr]:=10;
trans[scrapptr]:=0;
END;
BEGIN
tokmem[tokptr]:=141;
tokptr:=tokptr+1;
tokmem[tokptr]:=139;
tokptr:=tokptr+1;
tokmem[tokptr]:=20480+p;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=20;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
END;
11:BEGIN{166}
IF(scrapptr<scrapbase)OR((cat[scrapptr]<>10)
AND(cat[scrapptr]<>9))THEN
BEGIN
scrapptr:=scrapptr+1;
cat[scrapptr]:=10;
trans[scrapptr]:=0;
END;
BEGIN
tokmem[tokptr]:=141;
tokptr:=tokptr+1;
tokmem[tokptr]:=20480+p;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=6;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
END;
14:BEGIN
BEGIN
scrapptr:=scrapptr+1;
cat[scrapptr]:=12;
trans[scrapptr]:=0;
END;
BEGIN
tokmem[tokptr]:=141;
tokptr:=tokptr+1;
tokmem[tokptr]:=20480+p;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=7;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
END;
23:BEGIN
BEGIN
tokmem[tokptr]:=141;
tokptr:=tokptr+1;
tokmem[tokptr]:=92;
tokptr:=tokptr+1;
tokmem[tokptr]:=33;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=7;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
BEGIN
tokmem[tokptr]:=20480+p;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=8;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
END;
17:BEGIN
BEGIN
tokmem[tokptr]:=141;
tokptr:=tokptr+1;
tokmem[tokptr]:=139;
tokptr:=tokptr+1;
tokmem[tokptr]:=20480+p;
tokptr:=tokptr+1;
tokmem[tokptr]:=135;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=16;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
BEGIN
tokmem[tokptr]:=136;
tokptr:=tokptr+1;
tokmem[tokptr]:=92;
tokptr:=tokptr+1;
tokmem[tokptr]:=32;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=3;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
END;
18:BEGIN
BEGIN
tokmem[tokptr]:=20480+p;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=18;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
BEGIN
scrapptr:=scrapptr+1;
cat[scrapptr]:=3;
trans[scrapptr]:=0;
END;
END;
19:BEGIN
BEGIN
tokmem[tokptr]:=141;
tokptr:=tokptr+1;
tokmem[tokptr]:=136;
tokptr:=tokptr+1;
tokmem[tokptr]:=20480+p;
tokptr:=tokptr+1;
tokmem[tokptr]:=135;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=5;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
BEGIN
scrapptr:=scrapptr+1;
cat[scrapptr]:=3;
trans[scrapptr]:=0;
END;
END;
21:BEGIN{166}
IF(scrapptr<scrapbase)OR((cat[scrapptr]<>10)
AND(cat[scrapptr]<>9))THEN
BEGIN
scrapptr:=scrapptr+1;
cat[scrapptr]:=10;
trans[scrapptr]:=0;
END;
BEGIN
tokmem[tokptr]:=141;
tokptr:=tokptr+1;
tokmem[tokptr]:=139;
tokptr:=tokptr+1;
tokmem[tokptr]:=20480+p;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=6;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
BEGIN
scrapptr:=scrapptr+1;
cat[scrapptr]:=13;
trans[scrapptr]:=0;
END;
END;
22:BEGIN
BEGIN
tokmem[tokptr]:=141;
tokptr:=tokptr+1;
tokmem[tokptr]:=139;
tokptr:=tokptr+1;
tokmem[tokptr]:=20480+p;
tokptr:=tokptr+1;
tokmem[tokptr]:=135;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=19;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
BEGIN
scrapptr:=scrapptr+1;
cat[scrapptr]:=3;
trans[scrapptr]:=0;
END;
END;
OTHERS:BEGIN
nextcontrol:=ilk[p]-24;
GOTO 21;
END
END;
END;
128:BEGIN
tokmem[tokptr]:=92;
tokptr:=tokptr+1;
tokmem[tokptr]:=69;
tokptr:=tokptr+1;
tokmem[tokptr]:=123;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=15;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
9:BEGIN
tokmem[tokptr]:=92;
tokptr:=tokptr+1;
tokmem[tokptr]:=66;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=2;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
10:BEGIN
tokmem[tokptr]:=92;
tokptr:=tokptr+1;
tokmem[tokptr]:=84;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=2;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
12:BEGIN
tokmem[tokptr]:=92;
tokptr:=tokptr+1;
tokmem[tokptr]:=79;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=1;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
135:BEGIN
tokmem[tokptr]:=92;
tokptr:=tokptr+1;
tokmem[tokptr]:=44;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=2;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
134:{163}BEGIN
tokmem[tokptr]:=92;
tokptr:=tokptr+1;
tokmem[tokptr]:=104;
tokptr:=tokptr+1;
tokmem[tokptr]:=98;
tokptr:=tokptr+1;
tokmem[tokptr]:=111;
tokptr:=tokptr+1;
tokmem[tokptr]:=120;
tokptr:=tokptr+1;
tokmem[tokptr]:=123;
tokptr:=tokptr+1;
FOR j:=idfirst TO idloc-1 DO
BEGIN
IF tokptr+2>maxtoks THEN
BEGIN
Writeln(tty);
Write(tty,'! Sorry, ','token',' capacity exceeded');
Error;
Quit;
END;
tokmem[tokptr]:=buffer[j];
tokptr:=tokptr+1;
END;
BEGIN
tokmem[tokptr]:=125;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=1;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
END;
136:BEGIN
tokmem[tokptr]:=141;
tokptr:=tokptr+1;
Appcomment;
END;
137:BEGIN
tokmem[tokptr]:=142;
tokptr:=tokptr+1;
Appcomment;
END;
138:BEGIN
tokmem[tokptr]:=134;
tokptr:=tokptr+1;
tokmem[tokptr]:=92;
tokptr:=tokptr+1;
tokmem[tokptr]:=32;
tokptr:=tokptr+1;
BEGIN
tokmem[tokptr]:=134;
tokptr:=tokptr+1;
Appcomment;
END;
END;
139:BEGIN
scrapptr:=scrapptr+1;
cat[scrapptr]:=9;
trans[scrapptr]:=0;
END;
127:BEGIN
tokmem[tokptr]:=92;
tokptr:=tokptr+1;
tokmem[tokptr]:=74;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=2;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
OTHERS:BEGIN
tokmem[tokptr]:=nextcontrol;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=2;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END
END;
nextcontrol:=Getnext;
IF(nextcontrol=124)OR(nextcontrol=123)THEN GOTO 10;
END;
10:
END;
{168}
FUNCTION Pascaltransl:textpointer;
VAR
p:textpointer;
savebase:0..maxscraps;
BEGIN
savebase:=scrapbase;
scrapbase:=scrapptr+1;
Pascalparse;
IF nextcontrol<>124 THEN
BEGIN
IF NOT phaseone THEN
BEGIN
Writeln(tty);
Write(tty,'! Missing "|" after PASCAL text');
Error;
END;
END;
BEGIN
IF tokptr+2>maxtoks THEN
BEGIN
Writeln(tty);
Write(tty,'! Sorry, ','token',' capacity exceeded');
Error;
Quit;
END;
tokmem[tokptr]:=135;
tokptr:=tokptr+1;
END;
Appcomment;
p:=Translate;
{IF SCRAPPTR>MAXSCRPTR THEN MAXSCRPTR:=SCRAPPTR;}
scrapptr:=scrapbase-1;
scrapbase:=savebase;
Pascaltransl:=p;
END;
{169}PROCEDURE Outerparse;
VAR
bal:eightbits;
p,q:textpointer;
BEGIN
WHILE nextcontrol<140 DO
IF nextcontrol<>123 THEN
Pascalparse
ELSE
BEGIN
IF(tokptr+7>maxtoks)OR(textptr+3>maxtexts)OR(scrapptr>=maxscraps)
THEN
BEGIN
Writeln(tty);
Write(tty,'! Sorry, ','token/scrap',' capacity exceeded');
Error;
Quit;
END;
tokmem[tokptr]:=92;
tokptr:=tokptr+1;
tokmem[tokptr]:=67;
tokptr:=tokptr+1;
tokmem[tokptr]:=123;
tokptr:=tokptr+1;
bal:=Copycomment(1);
nextcontrol:=124;
WHILE bal>0 DO
BEGIN
p:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
q:=Pascaltransl;
tokmem[tokptr]:=40960+p;
tokptr:=tokptr+1;
tokmem[tokptr]:=51200+q;
tokptr:=tokptr+1;
IF nextcontrol=124 THEN bal:=Copycomment(bal)
ELSE bal:=0;
END;
tokmem[tokptr]:=141;
tokptr:=tokptr+1;
Appcomment;
END;
END;
{174}
PROCEDURE Pushlevel(p:textpointer);
BEGIN
IF stackptr=stacksize THEN
BEGIN
Writeln(tty);
Write(tty,'! Sorry, ','stack',' capacity exceeded');
Error;
Quit;
END
ELSE
BEGIN
IF stackptr>0 THEN stack[stackptr]:=curstate;
stackptr:=stackptr+1
{IF STACKPTR>MAXSTACKPTR THEN MAXSTACKPTR:=STACKPTR;}
curstate.tokfield:=tokstart[p];
curstate.endfield:=tokstart[p+1];
END;
END;
{176}
FUNCTION Getoutput:eightbits;
LABEL 20;
VAR a:sixteenbits;
BEGIN
20:
WHILE curstate.tokfield=curstate.endfield DO
BEGIN
stackptr:=
stackptr-1;
curstate:=stack[stackptr];
END;
a:=tokmem[curstate.tokfield];
curstate.tokfield:=curstate.tokfield+1;
IF a>=256 THEN
BEGIN
curname:=a MOD 10240;
CASE a DIV 10240 OF
2:a:=129;
3:a:=128;
4:BEGIN
Pushlevel(curname);
GOTO 20;
END;
5:BEGIN
Pushlevel(curname);
curstate.modefield:=inner;
GOTO 20;
END;
OTHERS:a:=130
END;
END;
{IF TROUBLESHOOT THEN DEBUGHELP;}
Getoutput:=a;
END;
{177}
PROCEDURE Makeoutput;
FORWARD;
PROCEDURE Outputpascal;
VAR
savetokptr,savetextptr,savenextcont:sixteenbits;
p:textpointer;
BEGIN
savetokptr:=tokptr;
savetextptr:=textptr;
savenextcont:=nextcontrol;
nextcontrol:=124;
p:=Pascaltransl;
tokmem[tokptr]:=p+51200;
tokptr:=tokptr+1;
Makeoutput;
{IF TEXTPTR>MAXTXTPTR THEN MAXTXTPTR:=TEXTPTR;
IF TOKPTR>MAXTOKPTR THEN MAXTOKPTR:=TOKPTR;}
textptr:=savetextptr;
tokptr:=savetokptr;
nextcontrol:=savenextcont;
END;
{178}
PROCEDURE Makeoutput;
LABEL 21,10,31;
VAR
a:eightbits;
b:eightbits;
k,klimit:0..maxbytes;
j:0..longbufsize;
stringdelimi:asciicode;
saveloc,savelimit:0..longbufsize;
savemode:mode;
BEGIN
tokmem[tokptr]:=143;
tokptr:=tokptr+1;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
Pushlevel(textptr-1);
WHILE true DO
BEGIN
a:=Getoutput;
21:
CASE a OF
143:GOTO 10;
130,129:{179}BEGIN
BEGIN
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=92;
END;
IF a=130 THEN
BEGIN
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=92;
END
ELSE
BEGIN
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=38;
END;
IF bytestart[curname+1]=bytestart[curname]+1 THEN
BEGIN
IF outptr=
linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=bytemem[bytestart[curname]];
END
ELSE Outname(curname);
END;
128:{183}BEGIN
BEGIN
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=92;
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=88;
END;
IF xmem[xref[curname]].numfield>=10240 THEN
Outval(xmem[xref[curname]].numfield-10240)
ELSE
BEGIN
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=48;
END;
BEGIN
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=58;
END;
{184}k:=bytestart[curname];
klimit:=bytestart[curname+1];
WHILE k<klimit DO
BEGIN
b:=bytemem[k];
k:=k+1;
IF b=64 THEN
{185}
BEGIN
IF bytemem[k]<>64 THEN
BEGIN
BEGIN
Writeln(tty);
Write(tty,'! Illegal control code in module name:');
END;
BEGIN
Writeln(tty);
Write(tty,'<');
END;
Printid(curname);
Write(tty,'> ');
END;
k:=k+1;
END;
IF b<>124 THEN
BEGIN
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=b;
END
ELSE
BEGIN{186}
j:=limit+1;
buffer[j]:=124;
stringdelimi:=0;
WHILE true DO
BEGIN
IF k>=klimit THEN
BEGIN
BEGIN
Writeln(tty);
Write(tty,'! PASCAL text in module name didn''t end:');
END;
BEGIN
Writeln(tty);
Write(tty,'<');
END;
Printid(curname);
Write(tty,'> ');
GOTO 31;
END;
b:=bytemem[k];
k:=k+1;
IF b=64 THEN
{187}
BEGIN
IF j>longbufsize-4 THEN
BEGIN
Writeln(tty);
Write(tty,'! Sorry, ','buffer',' capacity exceeded');
Error;
Quit;
END;
buffer[j+1]:=64;
buffer[j+2]:=bytemem[k];
j:=j+2;
k:=k+1;
END
ELSE
BEGIN
IF(b=34)OR(b=39)THEN
IF stringdelimi=0 THEN
stringdelimi
:=b
ELSE
IF stringdelimi=b THEN
stringdelimi:=0;
IF(b<>124)OR(stringdelimi<>0)THEN
BEGIN
IF j>longbufsize-3 THEN
BEGIN
Writeln(tty);
Write(tty,'! Sorry, ','buffer',' capacity exceeded');
Error;
Quit;
END;
j:=j+1;
buffer[j]:=b;
END
ELSE
GOTO 31;
END;
END;
31:;
saveloc:=loc;
savelimit:=limit;
loc:=limit+2;
limit:=j+1;
buffer[limit]:=124;
Outputpascal;
loc:=saveloc;
limit:=savelimit;
END;
END;
BEGIN
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=92;
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=88;
END;
END;
131,133,132:{180}BEGIN
BEGIN
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=92;
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=109;
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=97;
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=116;
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=104;
END;
IF a=131 THEN
BEGIN
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=98;
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=105;
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=110;
END
ELSE
IF a=132 THEN
BEGIN
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=114;
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=101;
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=108;
END
ELSE
BEGIN
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=111;
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=112;
END;
BEGIN
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=123;
END;
END;
135:BEGIN
REPEAT
a:=Getoutput;
UNTIL(a<139)OR(a>142);
GOTO 21;
END;
134:BEGIN
REPEAT a:=Getoutput;
UNTIL((a<139)AND(a<>32))OR(a>142);
GOTO 21;
END;
136,137,138,139,140,141,142:
{181}IF a<140 THEN
BEGIN
IF curstate.
modefield=outer THEN
BEGIN
BEGIN
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=92;
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=a-87;
END;
IF a=138 THEN
BEGIN
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=Getoutput;
END
END
ELSE
IF a=138 THEN
b:=Getoutput
END
ELSE
{182}
BEGIN
b:=a;
savemode:=curstate.modefield;
WHILE true DO
BEGIN
a:=Getoutput;
IF(a=135)OR(a=134)THEN
GOTO 21;
IF((a<>32)AND(a<140))OR(a>142)THEN
BEGIN
IF savemode=outer THEN
BEGIN
IF
outptr>3 THEN
IF(outbuf[outptr]=80)AND(outbuf[outptr-1]=92)
AND(outbuf[outptr-2]=89)
AND(outbuf[outptr-3]=92)THEN GOTO 21;
BEGIN
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=92;
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=b-87;
END;
IF a<>143 THEN
BEGIN
IF(outptr>0)OR(limit=0)THEN
Flushbuffer(outptr);
END;
END
ELSE
IF(a<>143)AND(curstate.modefield=inner)THEN
BEGIN
IF outptr=
linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=32;
END;
GOTO 21;
END;
IF a>b THEN
b:=a;
END;
END;
OTHERS:BEGIN
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=a;
END
END;
END;
10:
END;
{194}PROCEDURE Finishpascal;
VAR p:textpointer;
BEGIN
BEGIN
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=92;
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=80;
END;
BEGIN
IF tokptr+2>maxtoks THEN
BEGIN
Writeln(tty);
Write(tty,'! Sorry, ','token',' capacity exceeded');
Error;
Quit;
END;
tokmem[tokptr]:=141;
tokptr:=tokptr+1;
END;
Appcomment;
p:=Translate;
tokmem[tokptr]:=p+40960;
tokptr:=tokptr+1;
Makeoutput;
IF outptr>1 THEN
IF outbuf[outptr-1]=92 THEN
IF outbuf[outptr]=54 THEN
outptr:=outptr-2
ELSE
IF outbuf[outptr]=55 THEN
outbuf[outptr]:=89;
BEGIN
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=92;
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=112;
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=97;
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=114;
END;
BEGIN
IF(outptr>0)OR(limit=0)THEN
Flushbuffer(outptr);
END;
{IF TEXTPTR>MAXTXTPTR THEN MAXTXTPTR:=TEXTPTR;
IF TOKPTR>MAXTOKPTR THEN MAXTOKPTR:=TOKPTR;
IF SCRAPPTR>MAXSCRPTR THEN MAXSCRPTR:=SCRAPPTR;}tokptr:=1;
textptr:=1;
scrapptr:=0;
END;
{202}
PROCEDURE Footnote(flag:sixteenbits);
LABEL
30;
VAR
p,q,r:0..maxrefs;
BEGIN
BEGIN
IF(outptr>0)OR(limit=0)THEN
Flushbuffer(outptr);
END;
BEGIN
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=92;
END;
IF flag=0 THEN
BEGIN
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=85;
END
ELSE
BEGIN
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=65;
END;
BEGIN
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=32;
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=115;
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=101;
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=99;
END;
BEGIN
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=116;
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=105;
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=111;
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=110;
END;
{203}q:=0;
p:=curxref;
REPEAT
r:=xmem[p].xlinkfield;
xmem[p].xlinkfield:=q;
q:=p;
p:=r;
UNTIL xmem[p].numfield<=flag;
xmem[curxref].xlinkfield:=p;
;
{204}p:=q;
IF p<>curxref THEN
BEGIN
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=115;
END;
WHILE true DO
BEGIN
BEGIN
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=32;
END;
Outval(xmem[p].numfield-flag);
IF p=curxref THEN
GOTO 30;
p:=xmem[p].xlinkfield;
IF(p<>curxref)OR(p<>xmem[q].xlinkfield)THEN
BEGIN
IF outptr=linelength
THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=44;
END;
IF p=curxref THEN
BEGIN
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=32;
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=97;
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=110;
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=100;
END;
END;
30:;
BEGIN
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=46;
END;
END;
{212}
PROCEDURE Unbucket(d:eightbits);
VAR
c:asciicode;
BEGIN
FOR c:=100 DOWNTO 0 DO
IF bucket[collate[c]]>0 THEN
BEGIN
IF
scrapptr>maxscraps THEN
BEGIN
Writeln(tty);
Write(tty,'! Sorry, ','sorting',' capacity exceeded');
Error;
Quit;
END;
scrapptr:=scrapptr+1;
{IF SCRAPPTR>MAXSORTPTR THEN MAXSORTPTR:=SCRAPPTR;
}
IF c=0 THEN
cat[scrapptr]:=255
ELSE
cat[scrapptr]:=d;
trans[scrapptr]:=bucket[collate[c]];
bucket[collate[c]]:=0;
END;
END;
{220}
PROCEDURE Modprint(p:namepointer);
BEGIN
IF p>0 THEN
BEGIN
Modprint(link[p]);
BEGIN
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=92;
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=43;
END;
tokptr:=1;
textptr:=1;
scrapptr:=0;
tokmem[tokptr]:=p+30720;
tokptr:=tokptr+1;
Makeoutput;
BEGIN
IF(outptr>0)OR(limit=0)THEN
Flushbuffer(outptr);
END;
Modprint(ilk[p]);
END;
END;
{224}{PROCEDURE DEBUGHELP;
LABEL 888,10;
VAR K:SIXTEENBITS;
BEGIN
DEBUGSKIPPED:=DEBUGSKIPPED+1;
IF DEBUGSKIPPED<DEBUGCYCLE THEN GOTO 10;
DEBUGSKIPPED:=0;
888:['*************breakpoint*************';
'***********for**debugging***********']
WHILE TRUE DO
BEGIN
WRITE(TTY,'#');
READ(TTY,DDT);
IF DDT<0 THEN GOTO 10 ELSE IF DDT=0 THEN GOTO 888;
READ(TTY,DD);
CASE DDT OF
1:PRINTID(DD);
2:PRINTTEXT(DD);
3:FOR K:=1 TO DD DO WRITE(TTY,XCHR[BUFFER[K]]);
4:FOR K:=1 TO DD DO WRITE(TTY,XCHR[MODULE[K]]);
5:FOR K:=1 TO OUTPTR DO WRITE(TTY,XCHR[OUTBUF[K]]);
6:FOR K:=1 TO DD DO
BEGIN
PRINTCAT(CAT[K]);
WRITE(TTY,' ');
END;
OTHERS:WRITE(TTY,'?')
END;
END;
10:END;}
{225}BEGIN
Initialize;
{51}idloc:=10;
idfirst:=7;
buffer[7]:=97;
buffer[8]:=110;
buffer[9]:=100;
curname:=Idlookup(28);
idfirst:=5;
buffer[5]:=97;
buffer[6]:=114;
buffer[7]:=114;
buffer[8]:=97;
buffer[9]:=121;
curname:=Idlookup(4);
idfirst:=5;
buffer[5]:=98;
buffer[6]:=101;
buffer[7]:=103;
buffer[8]:=105;
buffer[9]:=110;
curname:=Idlookup(5);
idfirst:=6;
buffer[6]:=99;
buffer[7]:=97;
buffer[8]:=115;
buffer[9]:=101;
curname:=Idlookup(6);
idfirst:=5;
buffer[5]:=99;
buffer[6]:=111;
buffer[7]:=110;
buffer[8]:=115;
buffer[9]:=116;
curname:=Idlookup(7);
idfirst:=7;
buffer[7]:=100;
buffer[8]:=105;
buffer[9]:=118;
curname:=Idlookup(8);
idfirst:=8;
buffer[8]:=100;
buffer[9]:=111;
curname:=Idlookup(9);
idfirst:=4;
buffer[4]:=100;
buffer[5]:=111;
buffer[6]:=119;
buffer[7]:=110;
buffer[8]:=116;
buffer[9]:=111;
curname:=Idlookup(20);
idfirst:=6;
buffer[6]:=101;
buffer[7]:=108;
buffer[8]:=115;
buffer[9]:=101;
curname:=Idlookup(10);
idfirst:=7;
buffer[7]:=101;
buffer[8]:=110;
buffer[9]:=100;
curname:=Idlookup(11);
idfirst:=6;
buffer[6]:=102;
buffer[7]:=105;
buffer[8]:=108;
buffer[9]:=101;
curname:=Idlookup(4);
idfirst:=7;
buffer[7]:=102;
buffer[8]:=111;
buffer[9]:=114;
curname:=Idlookup(12);
idfirst:=2;
buffer[2]:=102;
buffer[3]:=117;
buffer[4]:=110;
buffer[5]:=99;
buffer[6]:=116;
buffer[7]:=105;
buffer[8]:=111;
buffer[9]:=110;
curname:=Idlookup(17);
idfirst:=6;
buffer[6]:=103;
buffer[7]:=111;
buffer[8]:=116;
buffer[9]:=111;
curname:=Idlookup(13);
idfirst:=8;
buffer[8]:=105;
buffer[9]:=102;
curname:=Idlookup(14);
idfirst:=8;
buffer[8]:=105;
buffer[9]:=110;
curname:=Idlookup(30);
idfirst:=5;
buffer[5]:=108;
buffer[6]:=97;
buffer[7]:=98;
buffer[8]:=101;
buffer[9]:=108;
curname:=Idlookup(7);
idfirst:=7;
buffer[7]:=109;
buffer[8]:=111;
buffer[9]:=100;
curname:=Idlookup(8);
idfirst:=7;
buffer[7]:=110;
buffer[8]:=105;
buffer[9]:=108;
curname:=Idlookup(16);
idfirst:=7;
buffer[7]:=110;
buffer[8]:=111;
buffer[9]:=116;
curname:=Idlookup(29);
idfirst:=8;
buffer[8]:=111;
buffer[9]:=102;
curname:=Idlookup(9);
idfirst:=8;
buffer[8]:=111;
buffer[9]:=114;
curname:=Idlookup(55);
idfirst:=4;
buffer[4]:=112;
buffer[5]:=97;
buffer[6]:=99;
buffer[7]:=107;
buffer[8]:=101;
buffer[9]:=100;
curname:=Idlookup(13);
idfirst:=1;
buffer[1]:=112;
buffer[2]:=114;
buffer[3]:=111;
buffer[4]:=99;
buffer[5]:=101;
buffer[6]:=100;
buffer[7]:=117;
buffer[8]:=114;
buffer[9]:=101;
curname:=Idlookup(17);
idfirst:=3;
buffer[3]:=112;
buffer[4]:=114;
buffer[5]:=111;
buffer[6]:=103;
buffer[7]:=114;
buffer[8]:=97;
buffer[9]:=109;
curname:=Idlookup(17);
idfirst:=4;
buffer[4]:=114;
buffer[5]:=101;
buffer[6]:=99;
buffer[7]:=111;
buffer[8]:=114;
buffer[9]:=100;
curname:=Idlookup(18);
idfirst:=4;
buffer[4]:=114;
buffer[5]:=101;
buffer[6]:=112;
buffer[7]:=101;
buffer[8]:=97;
buffer[9]:=116;
curname:=Idlookup(19);
idfirst:=7;
buffer[7]:=115;
buffer[8]:=101;
buffer[9]:=116;
curname:=Idlookup(4);
idfirst:=6;
buffer[6]:=116;
buffer[7]:=104;
buffer[8]:=101;
buffer[9]:=110;
curname:=Idlookup(9);
idfirst:=8;
buffer[8]:=116;
buffer[9]:=111;
curname:=Idlookup(20);
idfirst:=6;
buffer[6]:=116;
buffer[7]:=121;
buffer[8]:=112;
buffer[9]:=101;
curname:=Idlookup(7);
idfirst:=5;
buffer[5]:=117;
buffer[6]:=110;
buffer[7]:=116;
buffer[8]:=105;
buffer[9]:=108;
curname:=Idlookup(21);
idfirst:=7;
buffer[7]:=118;
buffer[8]:=97;
buffer[9]:=114;
curname:=Idlookup(22);
idfirst:=5;
buffer[5]:=119;
buffer[6]:=104;
buffer[7]:=105;
buffer[8]:=108;
buffer[9]:=101;
curname:=Idlookup(12);
idfirst:=6;
buffer[6]:=119;
buffer[7]:=105;
buffer[8]:=116;
buffer[9]:=104;
curname:=Idlookup(12);
idfirst:=3;
buffer[3]:=120;
buffer[4]:=99;
buffer[5]:=108;
buffer[6]:=97;
buffer[7]:=117;
buffer[8]:=115;
buffer[9]:=101;
curname:=Idlookup(23);
;
{84}phaseone:=true;
Resetinput;
modulecount:=0;
REPEAT
Skiplimbo;
IF NOT inputhasende THEN
REPEAT{85}
IF modulecount<10239 THEN
modulecount
:=modulecount+1
ELSE
BEGIN
Writeln(tty);
Write(tty,'! Sorry, ','module number',' capacity exceeded');
Error;
Quit;
END;
IF buffer[loc-1]=42 THEN
Write(tty,'*');
{88}
REPEAT
nextcontrol:=Skiptex;
CASE nextcontrol OF
126:xrefswitch:=10240;
125:xrefswitch:=0;
124:Pascalxref;
131,132,133,143:BEGIN
loc:=loc-2;
nextcontrol:=Getnext;
IF nextcontrol<>143 THEN
Newxref(Idlookup(nextcontrol-130));
END;
OTHERS:
END;
UNTIL nextcontrol>=140;
{90}
WHILE nextcontrol<=141 DO
BEGIN
xrefswitch:=10240;
IF nextcontrol=141 THEN
nextcontrol:=Getnext
ELSE
{91}
BEGIN
nextcontrol:=
Getnext;
IF nextcontrol=130 THEN
BEGIN
lhs:=Idlookup(0);
ilk[lhs]:=0;
Newxref(lhs);
nextcontrol:=Getnext;
IF nextcontrol=30 THEN
BEGIN
nextcontrol:=Getnext;
IF nextcontrol=130 THEN
BEGIN
rhs:=Idlookup(0);
ilk[lhs]:=ilk[rhs];
ilk[rhs]:=0;
Newxref(rhs);
ilk[rhs]:=ilk[lhs];
nextcontrol:=Getnext;
END;
END;
END;
END;
Outerxref;
END;
{92}
IF nextcontrol<=143 THEN
BEGIN
IF nextcontrol=142 THEN
modxrefswitc
:=0
ELSE
modxrefswitc:=10240;
REPEAT
IF nextcontrol=143 THEN
Newmodxref(curmodule);
nextcontrol:=Getnext;
Outerxref;
UNTIL nextcontrol>143;
END;
UNTIL nextcontrol=144;
UNTIL inputhasende;
phaseone:=false;
{95}Modcheck(ilk[0]);
;
{188}Resetinput;
BEGIN
Writeln(tty);
Write(tty,'Writing the output file...');
END;
modulecount:=0;
REPEAT
Copylimbo;
IF NOT inputhasende THEN
BEGIN
REPEAT{190}
modulecount:=modulecount+1;
{191}
BEGIN
IF(outptr>0)OR(limit=0)THEN
Flushbuffer(outptr);
END;
Flushbuffer(0);
BEGIN
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=92;
END;
IF buffer[loc-1]<>42 THEN
BEGIN
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=77;
END
ELSE
BEGIN
BEGIN
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=78;
END;
Write(tty,'*');
END;
Outval(modulecount);
BEGIN
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=46;
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=32;
END;
saveline:=outline;
saveplace:=outptr;
{192}
REPEAT
nextcontrol:=Copytex;
CASE nextcontrol OF
124:BEGIN
stackptr:=0;
curstate.modefield:=outer;
Outputpascal;
END;
64:BEGIN
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=64;
END;
12:BEGIN
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=92;
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=79;
END;
134,131,132,133,143:BEGIN
loc:=loc-2;
nextcontrol:=Getnext;
IF nextcontrol=134 THEN
BEGIN
IF NOT phaseone THEN
BEGIN
Writeln(tty);
Write(tty,'! TEX string should be in PASCAL text only');
Error;
END;
END;
END;
9,10,135,136,137,138,127,139:BEGIN
IF NOT phaseone THEN
BEGIN
Writeln(
tty);
Write(tty,'! You can''t do that in TEX text');
Error;
END;
END;
OTHERS:
END;
UNTIL nextcontrol>=140;
{193}
IF nextcontrol<=141 THEN
BEGIN
IF(saveline<>outline)OR(saveplace<>
outptr)THEN
BEGIN
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=92;
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=89;
END;
saveline:=outline;
saveplace:=outptr;
END;
WHILE nextcontrol<=141 DO
BEGIN
stackptr:=0;
curstate.modefield:=outer;
IF nextcontrol=141 THEN
{195}
BEGIN
BEGIN
tokmem[tokptr]:=92;
tokptr:=tokptr+1;
tokmem[tokptr]:=68;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=3;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
;
END;
nextcontrol:=Getnext;
IF nextcontrol<>130 THEN
BEGIN
IF NOT phaseone THEN
BEGIN
Writeln(tty);
Write(tty,'! Improper macro definition');
Error;
END;
END
ELSE
BEGIN
tokmem[tokptr]:=10240+Idlookup(0);
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=2;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
;
END;
nextcontrol:=Getnext;
END
ELSE
{196}
BEGIN
BEGIN
tokmem[tokptr]:=92;
tokptr:=tokptr+1;
tokmem[tokptr]:=70;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=3;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
;
END;
nextcontrol:=Getnext;
IF nextcontrol=130 THEN
BEGIN
BEGIN
tokmem[tokptr]:=10240+Idlookup(0);
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=2;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
;
END;
nextcontrol:=Getnext;
IF nextcontrol=30 THEN
BEGIN
BEGIN
tokmem[tokptr]:=92;
tokptr:=tokptr+1;
tokmem[tokptr]:=83;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=2;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
;
END;
nextcontrol:=Getnext;
IF nextcontrol=130 THEN
BEGIN
BEGIN
tokmem[tokptr]:=10240+Idlookup(0);
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=2;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
;
END;
BEGIN
scrapptr:=scrapptr+1;
cat[scrapptr]:=9;
trans[scrapptr]:=0;
END;
nextcontrol:=Getnext;
END;
END;
END;
IF scrapptr<>5 THEN
BEGIN
IF NOT phaseone THEN
BEGIN
Writeln(tty);
Write(tty,'! Improper format definition');
Error;
END;
END;
END;
Outerparse;
Finishpascal;
END;
{198}thismodule:=0;
IF nextcontrol<=143 THEN
BEGIN
IF(saveline<>outline)OR(saveplace<>outptr
)THEN
BEGIN
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=92;
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=89;
END;
stackptr:=0;
curstate.modefield:=outer;
IF nextcontrol=142 THEN
nextcontrol:=Getnext
ELSE
BEGIN
thismodule:=
curmodule;
{199}
REPEAT
nextcontrol:=Getnext;
UNTIL nextcontrol<>43;
IF(nextcontrol<>61)AND(nextcontrol<>30)THEN
BEGIN
IF NOT phaseone THEN
BEGIN
Writeln(tty);
Write(tty,'! You need an = sign after the module name');
Error;
END;
END
ELSE
nextcontrol:=Getnext;
IF outptr>1 THEN
IF(outbuf[outptr]=89)AND(outbuf[outptr-1]=92)THEN
BEGIN
tokmem[tokptr]:=139;
tokptr:=tokptr+1;
END;
BEGIN
tokmem[tokptr]:=30720+thismodule;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=22;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
;
END;
curxref:=xref[thismodule];
IF xmem[curxref].numfield<>modulecount+10240 THEN
BEGIN
BEGIN
tokmem[
tokptr]:=132;
tokptr:=tokptr+1;
tokmem[tokptr]:=43;
tokptr:=tokptr+1;
tokmem[tokptr]:=125;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=2;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
;
END;
thismodule:=0;
END;
BEGIN
tokmem[tokptr]:=92;
tokptr:=tokptr+1;
tokmem[tokptr]:=83;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=2;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
;
END;
BEGIN
tokmem[tokptr]:=141;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=9;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
;
END;
;
END;
WHILE nextcontrol<=143 DO
BEGIN
Outerparse;
{200}
IF nextcontrol<143 THEN
BEGIN
BEGIN
IF NOT phaseone THEN
BEGIN
Writeln(tty);
Write(tty,'! You can''t do that in PASCAL text');
Error;
END;
END;
nextcontrol:=Getnext;
END
ELSE
IF nextcontrol=143 THEN
BEGIN
BEGIN
tokmem[tokptr]:=30720+
curmodule;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=22;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
;
END;
nextcontrol:=Getnext;
END;
END;
Finishpascal;
END;
{201}
IF thismodule>0 THEN
BEGIN
curxref:=xmem[curxref].xlinkfield;
IF xmem[curxref].numfield>=10240 THEN
BEGIN
Footnote(10240);
curxref:=xmem[curxref].xlinkfield;
END;
IF curxref<>0 THEN
Footnote(0);
END;
;
UNTIL nextcontrol=144;
IF NOT inputhasende THEN
Writeendofpa;
END;
UNTIL inputhasende;
;
{205}buffer[0]:=32;
BEGIN
Writeln(tty);
Write(tty,'Writing the index...');
END;
BEGIN
IF(outptr>0)OR(limit=0)THEN
Flushbuffer(outptr);
END;
BEGIN
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=92;
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=105;
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=110;
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=120;
END;
BEGIN
IF(outptr>0)OR(limit=0)THEN
Flushbuffer(outptr);
END;
{207}
FOR c:=0 TO 127 DO bucket[c]:=0;
FOR h:=0 TO hashsize-1 DO
BEGIN
nextname:=hash[h];
WHILE nextname<>0 DO
BEGIN
curname:=nextname;
nextname:=link[curname];
IF xref[curname]<>0 THEN
BEGIN
c:=bytemem[bytestart[curname]];
IF(c<=90)AND(c>=65)THEN
c:=c+32;
blink[curname]:=bucket[c];
bucket[c]:=curname;
END;
END;
END;
{213}scrapptr:=0;
Unbucket(1);
WHILE scrapptr>0 DO
BEGIN
curdepth:=cat[scrapptr];
IF(blink[trans[scrapptr]]=0)OR(curdepth=255)THEN
{215}
BEGIN
curname:=
trans[scrapptr];
{IF TROUBLESHOOT THEN DEBUGHELP;}
REPEAT
BEGIN
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=92;
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=43;
END;
{216}
CASE ilk[curname]OF
0:BEGIN
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=92;
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=92;
END;
1:;
2:BEGIN
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=92;
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=57;
END;
3:BEGIN
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=92;
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=46;
END;
OTHERS:BEGIN
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=92;
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=38;
END
END;
Outname(curname);
{217}{219}thisxref:=xref[curname];
curxref:=0;
REPEAT
nextxref:=xmem[thisxref].xlinkfield;
xmem[thisxref].xlinkfield:=curxref;
curxref:=thisxref;
thisxref:=nextxref;
UNTIL thisxref=0;
REPEAT
BEGIN
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=44;
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=32;
END;
curval:=xmem[curxref].numfield;
IF curval<10240 THEN
Outval(curval)
ELSE
BEGIN
BEGIN
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=92;
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=91;
END;
Outval(curval-10240);
BEGIN
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=93;
END;
END;
curxref:=xmem[curxref].xlinkfield;
UNTIL curxref=0;
BEGIN
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=46;
END;
BEGIN
IF(outptr>0)OR(limit=0)THEN
Flushbuffer(outptr);
END;
;
curname:=blink[curname];
UNTIL curname=0;
scrapptr:=scrapptr-1;
END
ELSE
{214}
BEGIN
nextname:=trans[scrapptr];
REPEAT
curname:=nextname;
nextname:=blink[curname];
curbyte:=bytestart[curname]+curdepth;
IF curbyte=bytestart[curname+1]THEN
c:=0
ELSE
BEGIN
c:=bytemem[curbyte];
IF(c<=90)AND(c>=65)THEN
c:=c+32;
END;
blink[curname]:=bucket[c];
bucket[c]:=curname;
UNTIL nextname=0;
scrapptr:=scrapptr-1;
Unbucket(curdepth+1);
END;
END;
BEGIN
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=92;
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=102;
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=105;
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=110;
END;
BEGIN
IF(outptr>0)OR(limit=0)THEN
Flushbuffer(outptr);
END;
{221}Modprint(ilk[0]);
BEGIN
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=92;
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=99;
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=111;
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=110;
END;
BEGIN
IF(outptr>0)OR(limit=0)THEN Flushbuffer(outptr);
END;
Write(tty,'Done.');
;
9999:{[226]BEGIN WRITELN(TTY);
WRITE(TTY,'Memory usage statistics: ',NAMEPTR:0,' names, ',XREFPTR:0,
' cross references;');
END;
BEGIN
WRITELN(TTY);
WRITE(TTY,'parsing required ',MAXSCRPTR:0,' scraps, ',MAXTXTPTR:0,
' texts, ',MAXTOKPTR:0,' tokens, ',MAXSTACKPTR:0,' levels;');END;
BEGIN
WRITELN(TTY);
WRITE(TTY,'sorting required ',MAXSORTPTR:0,' levels.');
END;}
END.